Excel VBA嵌套循环效率

Question

我希望提高这个Excel VBA嵌套循环的速度。循环将一个工作表中的日期与第二个工作表中的日期进行比较。如果它们匹配，我会更改单元格周围的边框以突出显示它。它目前运行良好，但处理每个sub大约需要30秒。有没有一种方法可以实现数组或其他策略来加速它？提前感谢！

Sub Single()

Dim DateRng As Range, DateCell As Range, DateRngPay As Range
Dim cellA As Range
Dim cellB As Range
Dim myColor As Variant

Set DateRng = ActiveWorkbook.Worksheets("SS").Range("B11:F16,I11:M16,P11:t16,B19:F24,I19:M24,P19:t24,B27:F32,I27:M32,P27:t32,B35:F40,I35:M40,P35:t40")
Set DateRngPay = ActiveWorkbook.Worksheets("PS").Range("C2:C67")
myColor = Array("38")

If ActiveWorkbook.Worksheets("Info").Range("B67") = 1 Then
    With DateRng
            .Interior.ColorIndex = xlColorIndexNone
            '.Borders.LineStyle = xlContinuous
            .Borders.ColorIndex = 1
            .Borders.Weight = xlHairline
    For Each cellA In DateRng
        For Each cellB In DateRngPay
                If cellB.Value > "" And cellA.Value > "" And cellB.Value = cellA.Value Then
                With cellA.Borders
                    .ColorIndex = myColor
                    .Weight = xlMedium
                End With
                Exit For
            End If
        Next cellB
    Next cellA
    End With
End If
End Sub

Answer 1

您是否尝试过在代码顶部使用Application.ScreenUpdating = False，然后在代码底部使用Application.ScreenUpdating = True？它禁用屏幕更新和我的宏去很多更快。您还可以禁用(然后重新启用)其他设置，例如this website。

更新后的OP评论说Application.ScreenUpdating = False并没有提高速度：

​

我稍微修改了一下你的代码，看到了一些速度上的提高。你的代码通常需要大约0.65秒才能完成，而我的代码大约需要0.51秒。这段代码会为你加速吗？

Sub SingleIsAnIdentifier_SoItCannotBeUsedAsASubName()

Dim DateRng As Range, DateCell As Range, DateRngPay As Range
Dim cellA As Range
Dim cellB As Range
Dim myColor As Integer

Dim RngToColor As Range 'Range to hold all cells to give a colored border.

Set DateRng = ActiveWorkbook.Worksheets("SS").Range("B11:F16,I11:M16,P11:t16,B19:F24,I19:M24,P19:t24,B27:F32,I27:M32,P27:t32,B35:F40,I35:M40,P35:t40")
Set DateRngPay = ActiveWorkbook.Worksheets("PS").Range("C2:C67")
myColor = 38

If ActiveWorkbook.Worksheets("Info").Range("B67") = 1 Then
    With DateRng
            .Interior.ColorIndex = xlColorIndexNone
            '.Borders.LineStyle = xlContinuous
            .Borders.ColorIndex = 1
            .Borders.Weight = xlHairline
    End With
    For Each cellA In DateRng
        For Each cellB In DateRngPay
            If cellB.Value > "" And cellA.Value > "" And cellB.Value = cellA.Value Then

                ' Add cellA to the range. The range will be colored later.
                If Not RngToColor Is Nothing Then
                    Set RngToColor = Union(RngToColor, cellA)
                Else
                    Set RngToColor = cellA
                End If

            End If
        Next cellB
    Next cellA
End If

' Color all cells in the range.
With RngToColor.Cells.Borders
    .ColorIndex = myColor
    .Weight = xlMedium
End With

End Sub

我将cellA保存在另一个范围(RngToColor)中，而不是在cellA.value = cellB.value时立即给cellA的边框着色。在代码末尾，我对该范围内的所有边框进行了着色。而且，Dim myColor As Variant和后来的myColor = Array("38")对我不起作用(.ColorIndex = myColor抱怨)，所以我把它改成了Integer。