VBA代码iCell.Value赋值耗时过长，如何优化400行循环执行速度？

你的代码慢的核心原因是逐个单元格读写操作，加上字符串拼接和冗余代码的额外开销，以下是具体优化方法：

核心优化措施 #

• 用内存数组替代单元格遍历：单元格IO是VBA中性能最差的操作之一，把整个区域的数据一次性读到内存数组里处理，最后批量写回单元格，能把IO次数从几万次降到2次。
• 优化字符串拼接：用&拼接字符串每次都会生成新对象，循环次数多了会严重拖慢速度，改用Scripting.StringBuilder来拼接，效率能提升几十倍。
• 消除冗余代码：原代码里indirizzo = iCell.Address、循环内重复读取iCell.Value都是无用操作，直接删掉。
• 强制变量声明：给所有变量指定具体类型（比如lunghezza声明为Integer），避免变体类型的额外开销。

优化后的代码 #

方法1：引用Scripting Runtime（推荐） #

先打开VBA编辑器，点击「工具」→「引用」，勾选「Microsoft Scripting Runtime」，然后用下面的代码：

Sub Decr_Optimized()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim dataArr As Variant
    Dim i As Long, j As Long, counter As Integer
    Dim cellValue As String
    Dim sb As New StringBuilder
    Dim lunghezza As Integer
    Dim carattere_da_decriptare As String
    Dim carattere_da_sostituire As String
    
    ' 一次性读取整个区域到数组
    dataArr = Range("A1:BK460").Value
    
    ' 遍历数组处理数据
    For i = LBound(dataArr, 1) To UBound(dataArr, 1)
        For j = LBound(dataArr, 2) To UBound(dataArr, 2)
            cellValue = CStr(dataArr(i, j))
            lunghezza = Len(cellValue)
            sb.Clear ' 清空StringBuilder
            
            For counter = 1 To lunghezza
                carattere_da_decriptare = Mid(cellValue, counter, 1)
                carattere_da_sostituire = Chr(Asc(carattere_da_decriptare) - 10)
                sb.Append carattere_da_sostituire
            Next counter
            
            ' 把处理后的值存回数组
            dataArr(i, j) = sb.ToString
        Next j
    Next i
    
    ' 一次性把数组写回单元格
    Range("A1:BK460").Value = dataArr
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

方法2：无需引用（用CreateObject） #

如果不想添加引用，用CreateObject创建StringBuilder：

Sub Decr_Optimized_NoRef()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim dataArr As Variant
    Dim i As Long, j As Long, counter As Integer
    Dim cellValue As String
    Dim sb As Object
    Dim lunghezza As Integer
    Dim carattere_da_decriptare As String
    Dim carattere_da_sostituire As String
    
    Set sb = CreateObject("System.Text.StringBuilder")
    
    ' 一次性读取整个区域到数组
    dataArr = Range("A1:BK460").Value
    
    ' 遍历数组处理数据
    For i = LBound(dataArr, 1) To UBound(dataArr, 1)
        For j = LBound(dataArr, 2) To UBound(dataArr, 2)
            cellValue = CStr(dataArr(i, j))
            lunghezza = Len(cellValue)
            sb.Length = 0 ' 清空StringBuilder
            
            For counter = 1 To lunghezza
                carattere_da_decriptare = Mid(cellValue, counter, 1)
                carattere_da_sostituire = Chr(Asc(carattere_da_decriptare) - 10)
                sb.Append carattere_da_sostituire
            Next counter
            
            ' 把处理后的值存回数组
            dataArr(i, j) = sb.ToString
        Next j
    Next i
    
    ' 一次性把数组写回单元格
    Range("A1:BK460").Value = dataArr
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    Set sb = Nothing
End Sub

额外优化提示 #

如果你的解密逻辑只是每个字符ASCII减10，还可以用StrConv结合自定义转换进一步简化循环，但上面的方法已经能把耗时从30秒降到1秒以内。

内容的提问来源于stack exchange，提问作者Corrado