使用Union()提高格式化宏的速度

时间:2019-06-12 23:53:16

标签: excel vba

我正在为报表编写格式宏,但是我想出的运行速度并没有达到我想要的速度。任何帮助或建议增加速度将不胜感激。

将以下代码放在一起时,我的想法是,如果我遍历每一行,并确定需要对其应用格式的范围,则使用union()合并为单个范围,然后在末尾应用格式,这比单独为每行应用格式要快。考虑到这段代码要花多长时间才能运行约40k行,我不确定情况是否如此。

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分钟。任何帮助将不胜感激。

1 个答案:

答案 0 :(得分:0)

逐个单元读取数据通常比加载到数组并从那里读取要慢。

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轴上的对数比例(时间以秒为单位)

enter image description here