Увеличьте скорость форматирования макроса с помощью Union ()

Question

Я пишу макрос форматирования для отчета, но то, что я придумал, работает не так быстро, как хотелось бы. Любая помощь или предложения по увеличению скорости будет принята с благодарностью.

Я подумал, когда собирал код ниже: если я переберу каждую строку и определю диапазоны, к которым нужно применить форматирование, объединяю их в один диапазон с помощью union (), а затем применю формат в конце , это будет быстрее, чем применять формат для каждой строки в отдельности. Я не уверен, что это так, учитывая, сколько времени потребовалось для выполнения этого кода около 40 тысяч строк

Dim FinalRowReport As Long
Dim i As Long
Dim rangeFormat As Range
Dim rangeBold As Range
Dim rangeColor As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

FinalRowReport = Cells(Rows.Count, 1).End(xlUp).Row

For i = 4 To FinalRowReport
    If Cells(i, 2) = Cells(i - 1, 2) Then
        If rangeColor Is Nothing Then
            Set rangeColor = Range(Cells(i, 1), Cells(i, 12))
        Else
            Set rangeColor = Union(rangeColor, Range(Cells(i, 1), Cells(i, 12)))
        End If
    End If
    If Right(Cells(i, 2).Value, 5) = "Total" Then
        If rangeFormat Is Nothing Then
            Set rangeFormat = Range(Cells(i, 1), Cells(i, 19))
            Set rangeBold = Range(Cells(i, 20), Cells(i, 23))
        Else
            Set rangeFormat = Union(rangeFormat, Range(Cells(i, 1), Cells(i, 23)))
            Set rangeBold = Union(rangeBold, Range(Cells(i, 20), Cells(i, 23)))
        End If
    End If
Next i

rangeColor.Font.Color = RGB(255, 255, 255)
rangeFormat.Interior.Color = RGB(217, 217, 217)
rangeFormat.Font.Color = RGB(217, 217, 217)
rangeBold.Interior.Color = RGB(217, 217, 217)
rangeBold.Font.Bold = True
With rangeFormat.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThick
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Код работает - он очень длинный, может быть, около 20 минут. Любая помощь будет принята с благодарностью.

Answer 1

Поэтапное чтение данных обычно медленнее, чем загрузка в массив и чтение оттуда.

Dim FinalRowReport As Long
Dim i As Long
Dim rangeFormat As Range
Dim rangeBold As Range
Dim rangeColor As Range
Dim data

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

FinalRowReport = Cells(Rows.Count, 1).End(xlUp).Row
data = Cells(1, 2).Resize(FinalRowReport).Value 

For i = 4 To FinalRowReport
    If data(i, 1) = data(i - 1, 1) Then
        BuildRange rangeColor, Range(Cells(i, 1), Cells(i, 12))
    End If
    If Right(data(i, 1).Value, 5) = "Total" Then
        BuildRange rangeFormat, Range(Cells(i, 1), Cells(i, 19))
        BuildRange rangeBold = Range(Cells(i, 20), Cells(i, 23))     
    End If
Next i

rangeColor.Font.Color = RGB(255, 255, 255)
rangeFormat.Interior.Color = RGB(217, 217, 217)
rangeFormat.Font.Color = RGB(217, 217, 217)
rangeBold.Interior.Color = RGB(217, 217, 217)
rangeBold.Font.Bold = True
'...
'...

'utility sub for building a range
Sub BuildRange(ByRef rngTot As Range, rngAdd as range)
    if rngTot is nothing then
        set rngTot = rngAdd
    else
        set rngTot = application.union(rngTot, rngAdd)
    end if

end sub

РЕДАКТИРОВАТЬ - небольшое тестирование, основанное на комментариях Valantic о том, что время от времени пакетирование строится.Это имеет большее значение, чем я ожидал.

Код теста:

Sub TTT()
    Const N_COMMIT = 500 '<< "commit" and reset the range every this many unions
    Dim i As Long, t, c, rng As Range, n As Long

    Columns(1).Interior.ColorIndex = xlNone

    t = Timer
    For i = 1 To 2000# Step 1

        BuildRange rng, Cells(i * 2, 1)
        n = n + 1

        If n >= N_COMMIT Then
            rng.Interior.Color = vbRed
            Set rng = Nothing
            n = 0
        End If

        If i Mod 250 = 0 Then Debug.Print i, Timer - t
    Next i

    If Not rng Is Nothing Then rng.Interior.Color = vbRed

End Sub

Результаты : общее время выполнения зависит от частоты коммитов, с 25 (в моих тестах) быть "сладким пятном" с точки зрения производительности.Обратите внимание, что этот график логарифмический масштаб по оси Y (время в секундах)