循环速度提升

Question

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

我在英特尔 I5-6300U CPU @ 2.4Ghz 上运行 Excel 2016 64 位，加速到 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

Answer 1

关闭计算和事件，代码之外的东西会导致问题。

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