VBA加速For循环与数组?

Question

我试图加快我的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

Answer 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对象数次。

Answer 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