L oop улучшение скорости - PullRequest
Новая
       26

L oop улучшение скорости

0 голосов
/ 08 апреля 2020

Я ищу помощи в улучшении скорости этого макроса. Он является частью гораздо большего макроса, но после тестирования каждой его части в отдельности этот раздел занимает 98% времени. Всего этот макрос занимает около 25-30 минут. В рабочей тетради всего 12 листов. Каждый лист содержит около 200 строк и 50 столбцов, но это не имеет большого значения для этого фрагмента кода. Я не уверен, есть ли лучший способ сделать это или у вас есть какие-либо идеи, почему это занимает так много времени.

Я использую 64-разрядную версию Excel 2016 на процессоре Intel I5-6300U с тактовой частотой 2,4 ГГц, с турбонаддувом до 3 ГГц. Во время запуска этого марко я бью около 2,85 ГГц без запуска других программ. 8 ГБ ОЗУ. 

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

1 Ответ

4 голосов
/ 08 апреля 2020

отключить вычисления и события, что-то вне кода вызывает проблему. 

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
...