宏的VBA处理速度

Question

我有这个代码：

Option Explicit

Private Sub Label1_Click()

Application.ScreenUpdating = False

Dim ws As Worksheet
Dim rng1 As Range

Set ws = ActiveWorkbook.ActiveSheet

ws.Cells(3, 3).Activate

'runs a loop for active range - tests if the product on current line matched the line above and then returns a variance

Do While ActiveCell <> vbNullString
    ActiveCell.Offset(0, 11).Interior.ColorIndex = 19

    'formatting & formulation
    With ActiveCell.Offset(0, 12)
        .FormulaArray = "=IFERROR(SUM(IF(C" & ActiveCell.Row & "=ItemCode,ValueAmt))/SUM(IF(C" & ActiveCell.Row & "=ItemCode,KGs)),I" & ActiveCell.Row & ")"
        .Interior.ColorIndex = 19
        .NumberFormat = "0.0000"
        .Font.ColorIndex = xlAutomatic
        .Font.TintAndShade = 0
        .Font.Bold = True
    End With


    'clearing all but last row for each product
'   If ActiveCell = ActiveCell.Offset(1, 0) Then
'   ActiveCell.Offset(0, 12).ClearContents
'   End If

    ActiveCell.Offset(1, 0).Activate

    'looping data
        If ActiveCell.Offset(-1, 0) = ActiveCell Then

            If ActiveCell.Offset(-1, 7) = 0 Then
            ActiveCell.Offset(0, 11).Value = ActiveCell.Offset(0, 7).Value
            Else
            ActiveCell.Offset(0, 11).Value = ((ActiveCell.Offset(0, 7).Value - ActiveCell.Offset(-1, 7).Value) / ActiveCell.Offset(-1, 7).Value)
            End If

        End If

Loop

With Columns(ws.UsedRange.Columns.Count)
    .NumberFormat = "0.00%"
End With

With UsedRange
    .Columns.AutoFit
    .Rows.AutoFit
End With

'MsgBox "run macro"
Application.ScreenUpdating = True

End Sub

按我的意愿工作，它获取成本信息并逐项生成差异（如果项目代码匹配）和加权平均成本。

我的问题是，即使屏幕更新 = false，处理速度也很慢。我知道这与 ACTIVECELL OFFSET 有关，因为我知道这是执行循环的减慢方式。我遇到的问题是，因为我的公式是一个数组公式，我必须使用 .FormulaArray 属性，我认为这是减慢它的原因。

有没有人知道一种更好的方法来重新构造此代码以实现相同/相似的结果？我也许可以尝试一个 Do While 循环。

Answer 1

除了 ScreenUpdating，您还可以在运行代码之前尝试将 Calculation 设置为手动。

Application.Calculation = xlCalculationManual

然后一旦循环完成，再次打开它：

Calculate
Application.Calculation = xlAutomatic