VBA 将公式应用于给定范围花费的时间太长

Question

请参考下图。 VBA 根据最新的季度信息，代码需要 30 多分钟才能将 F 列中的公式更新到最后一行。

例如，如果我有 Q1 数据 和 Q2 数据 那么公式应该根据 Q2 数据计算，因为它是 最近一个季度。 这是主要要求。

我做了以下事情。

1) 为每个 quarter/Column
Q1 =OFFSET(Data!$B;0;0;COUNTA(Data!$A:$A)-1;1) 创建了一个 Named rages；
Q2 =OFFSET(Data!$C;0;0;COUNTA(Data!$A:$A)-1;1)；
Q3 =OFFSET(Data!$D;0;0;COUNTA(Data!$A:$A)-1;1)；
Q4 =OFFSET(Data!$E;0;0;COUNTA(Data!$A:$A)-1;1);

2) 现在，在 F 列 中，我通过 VBA 代码 =IF(Q4_Range>0;E2;IF(Q3_Range>0;D2;IF(Q2_Range>0;C2;IF(Q1_Range>0;B2;"")))) 包含了以下 IF 条件

这是 VBA 编辑器中的样子
ActiveCell.FormulaR1C1 =_ "=IF(Q4_Range>0,RC[-1],IF(Q3_Range>0,RC[-2],IF(Q2_Range>0,RC[-3],IF(Q1_Range>0,RC[-4],""""))))"

当我运行 VBA 编码时 需要 30 多分钟才能将此公式复制到最后一行 这是动态的并且将是大约 50,000 到 80,000 行。

我的完整代码

Sub Add_Formula()

Dim Sht As Worksheet
Dim LastRow As Long

    Set StartCell = Range("A2")

    LastRow = Sht.Cells(Sht.Rows.Count, StartCell.Column).End(xlUp).Row

      Range("F2:F" & LastRow).Select
      Range("F2:F" & LastRow).FormulaR1C1 = "=IF(FF3_RANGE>0,RC[-1],IF(FF2_RANGE>0,RC[-2],IF(FF1_RANGE>0,RC[-3],IF(FF0_RANGE>0,RC[-4],))))"

      Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"

End Sub

有没有办法通过更改 VBA 代码来加快处理速度？

Answer 1

以下几点可以提供帮助：

如果您在 F 列中只需要最新季度的值（单元格 Bx:Ex），那么您可以简化您的公式，而无需使用动态命名范围。 This answer 为您显示了几个选项，但由于您几乎肯定在看数字，因此 F 列中的公式应该是 =LOOKUP(9.99E+307,$B2:$E2).
您已经使用 VBA（即 =LOOKUP(9.99E+307,RC2:RC5)）应用公式的正确方法，但您应该始终 avoid using Select or Activate.
加快进程的真正关键是 disable screen updates and automatic calculation。

以全部包裹在一起为例：

Option Explicit

Sub Add_Formula()
    ToggleAppUpdates False
    Dim Sht As Worksheet
    Set Sht = Worksheets("Sheet1")
    With Sht
        Dim startCell As Range
        Set startCell = .Range("A2")
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, startCell.Column).End(xlUp).Row
        With .Range("F2:F" & lastRow)
            .FormulaR1C1 = "=LOOKUP(9.99E+307,RC2:RC5)"
            .NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
        End With
    End With
    ToggleAppUpdates True
End Sub

Sub ToggleAppUpdates(ByVal state As Boolean)
    With Application
        .ScreenUpdating = state
        .Calculation = IIf(state, xlCalculationAutomatic, xlCalculationManual)
    End With
End Sub

VBA 将公式应用于给定范围花费的时间太长

VBA taking too long to apply the formula to the given range

excel

vba

excel-formula

excel-2016

我的完整代码