Ускорить макрос Excel?

Question

Прямо сейчас у меня есть макрос PopulateYearlyValues Но мне кажется, это занимает слишком много времени

Sub PopulateYearlyValues(ByVal Month As Range)
    Dim c As Double
    Dim s As Double
    c = Application.WorksheetFunction.Match(UCase(Month.Value), ActiveSheet.Range("AA5:AX5"), 0)
    s = (ActiveSheet.Range("AA5").Column - 1)
    With ActiveSheet
        Dim i As Integer
        Dim j As Integer
        For i = 7 To 44
            .Range("G" & i).Value = 0
            .Range("H" & i).Value = 0
            For j = 1 To c
                .Range("G" & i).Value = (.Range("G" & i).Value + .Cells(i, s).Offset(0, j))
                .Range("H" & i).Value = (.Range("H" & i).Value + .Cells(i, s).Offset(0, (j + 1)))
                j = j + 1
            Next j
        Next i
    End With
End Sub

У меня есть диапазон G7:H44, который должен быть заполнен SUM диапазона AA7:AX44, но ... это только каждый второй столбец:

If Month.Value = "January"
    G7  = SUM(AA7)
    H7  = SUM(AB7)
    ...
    G44 = SUM(AA44)
    H44 = SUM(AB44)
End If

If Month.Value = "April"
    G7  = SUM(AA7, AC7, AE7, AG7)
    H7  = SUM(AB7, AD7, AF7, AH7)
    ...
    G44 = SUM(AA44, AC44, AE44, AG44)
    H44 = SUM(AB44, AD44, AF44, AH44)
End If

Но мой макрос занимает слишком много времени .. Есть ли другой способ сделать это?

Answer 1

Вы можете попробовать обычные методы оптимизации VBA, установив расчет вручную и отключив ScreenUpdating.

Dim calc As XlCalculation
calc = Application.Calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Application.ScreenUpdating = True
Application.Calculation = calc

Поместите ваш код или вызов функции между Application.Calculation = xlCalculationManual и Application.ScreenUpdating = True

Это из моего предыдущего поста

Answer 2

В качестве продолжения вы также можете установить для Application.EnableEvents значение false (и впоследствии вернуть его в значение true), чтобы потенциально сэкономить время в зависимости от того, что делает ваша процедура.

Answer 3

Могу ли я предложить формулу: SUMIF будет суммировать базу по критериям

SUMIF($AA$99:$AX$99;"=1";$AA7:$AX7) ' for G column
SUMIF($AA$99:$AX$99;"=2";$AA7:$AX7) ' for H column

Ячейки в строке 99 (могут быть скрыты ) имеют условие на основе Месяц.Value и столбец, дающий "0" (пока не сумма), "1" (сумма в столбце G) или "2" (сумма в столбце H):

=IF(Month.Value>=ROUNDDOWN((COLUMN(AA3)-25)/2;0);2-MOD(COLUMN(AA3);2);0)

С уважением

Ален

Answer 4

Я не могу сказать, изменил ли я это, когда обновил свой PopulateYearlyValues или что, но теперь я столкнулся с другой проблемой ..

G7 = Actual | H7 = Plan | I7 = (G7 - H7) | J7 =IF(OR(G7 = 0, I7 = 0), 0, I7 / G7)

Поскольку я изменил вышеуказанный подпункт, I7 и J7 остаются неизменными при изменении выбора месяца. G7 и H7 обновляются корректно.

Я нашел исправление, но, похоже, должен быть лучший способ ..

For i = 7 To 44
    For j = 1 To Application.WorksheetFunction.Match(UCase(Target.Value), .Range("AA5:AX5"), 0)
        .Range("I" & i).Value = "=G" & i & "-H" & i &")"
        .Range("J" & i).Value = "=IF(OR(G" & i & "=0, H" & i & "=0), 0, I" & i & " / G" & i & ")"
    Next j
Next i