循环速度改进

Loop speed improvement

我正在寻求帮助以提高此宏的速度。它是一个更大的宏的一部分,但在单独测试它的每个部分之后,该部分占用了 98% 的时间。这个宏总共需要大约 25-30 分钟。工作簿中只有 12 sheet。每个 sheet 大约有 200 行和 50 列,这与这段代码无关。我不确定是否有更好的方法来执行此操作,或者您是否对为什么需要这么长时间有任何见解。

我是 运行 Excel 2016 64 位英特尔 I5-6300U CPU @ 2.4Ghz,加速到 3Ghz。虽然 运行 这个 marco 我在没有其他程序的情况下达到 2.85Ghz 左右 运行。 8GB 内存。

Sub step3()

Dim sht As Worksheet

Application.ScreenUpdating = False

For Each sht In ActiveWorkbook.Worksheets

    If sht.Name <> "Directions" Then
        'Update months in colA
        sht.Range("A5").Formula = "=EOMONTH(TODAY(),-1)"
        sht.Range("A6").Formula = "=EOMONTH(TODAY(),-2)"
        sht.Range("A7").Formula = "=EOMONTH(TODAY(),-3)"
        sht.Range("A5:A7").Copy
        sht.Range("A5:A7").PasteSpecial xlPasteValues
    End If

Next sht

Application.ScreenUpdating = True
End Sub

关闭计算和事件,代码之外的东西导致了这个问题。

Sub step3()
    On Error GoTo safeout
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim sht As Worksheet
    For Each sht In ActiveWorkbook.Worksheets

        If sht.Name <> "Directions" Then
            With sht.Range("A5:A7")
                .Formula = "=EOMONTH(TODAY(),-ROW(1:1))"
                .Value = .Value
            End With
        End If

    Next sht
safeout:
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    Application.EnableEvents = True
End Sub