VBA用数组/字典加速For循环？答案

【问题标题】：VBA speed up For loop with array/dictionary?VBA用数组/字典加速For循环？
【发布时间】：2021-08-24 19:20:27
【问题描述】：

我正在尝试加快我的 For 循环，因为对于一些具有许多行/更多列的工作表来说，它需要很长时间。已经用数组和字典尝试了一些东西，但我不明白。如何优化此代码以检查单元格的内容并将新计算的内容（如果为真）插入其他单元格？非常感谢！

    Pos = 1
    lngWS = ws_Table.ListRows.Count
    
    For Pos = Pos To lngWS
        If ws_Table.DataBodyRange(Pos, Column_Date).Value2 <> vbNullString And _
           ws_Table.DataBodyRange(Pos, Column_Verify).Value2 <> "OK" Then

            ws_Table.DataBodyRange(Pos, Column_Year).Value2 = Year(ws_Table.DataBodyRange(Pos, Column_Date).Value2)
            ws_Table.DataBodyRange(Pos, Column_Month).Value2 = Format(ws_Table.DataBodyRange(Pos, Column_Date).Value2, "MMMM")

            ws_Table.DataBodyRange(Pos, Column_Compare_1).FormulaLocal = "=1+1"
            ws_Table.DataBodyRange(Pos, Column_Compare_1).Value2 = ws_Table.DataBodyRange(Pos, Column_Compare_1).Value2
            ws_Table.DataBodyRange(Pos, Column_Compare_2).FormulaLocal = "=2+2"
            ws_Table.DataBodyRange(Pos, Column_Compare_2).Value2 = ws_Table.DataBodyRange(Pos, Column_Compare_2).Value2

        End If
    Next Pos

【问题讨论】：

标签： excel vba

【解决方案1】：

为了加快处理范围内的数据，将数据从范围复制到数组，处理数组，然后将数据复制回范围会更快。

这适用于具有多个单元格的范围：

Dim Lst as Variant ' The array
Dim Idx as Long ' The row index

' First copy the range to an array
Lst = ws_Table.DataBodyRange
For Idx = LBound(Lst) To UBound(Lst)
    ' Change the rows in the array here, for example:
    '     Lst(Idx, 1) = Lst(Idx, 1) * 3
    '
    ' Be aware that you might need to recreate your formulas, as 
    ' it is the results of the forumalas that are copied to the array:
    '     Lst(Idx, 2) = "=1+1"
Next Idx
' Then copy the array back to the range
ws_Table.DataBodyRange = Lst

处理数组之所以快，是因为它是内存中的数据结构，而列表对象、范围或单元格是 COM 对象。引用 COM 对象需要很长时间。

我推荐的方法只引用一个 COM 对象 2 或 3 次，而您的示例中使用的方法或 Tim Williams 提出的解决方案，为范围内的每一行引用一个 COM 对象多次。

【讨论】：

【解决方案2】：

这可能会快一点：

Dim dtVal, verVal, pos As Long
'...
'...

Application.ScreenUpdating = False
For pos = 1 To ws_Table.ListRows.Count
    With ws_Table.DataBodyRange.Rows(pos)
        
        dtVal = .Cells(Column_Date).Value2
        verVal = .Cells(Column_Verify).Value2
        
        If Len(dtVal) > 0 And verVal <> "OK" Then

            .Cells(Column_Year).Value2 = Year(dtVal)
            .Cells(Column_Month).Value2 = Format(dtVal, "MMMM")

            With .Cells(Column_Compare_1)
                .FormulaLocal = "=1+1"
                .Value = .Value
            End With
            With .Cells(Column_Compare_2)
                .FormulaLocal = "=2+2"
                .Value2 = .Value2
            End With
        End If 'have date and not "OK"
    End With
Next pos

【讨论】：