如何在 VBA 中加快 For Each 循环？答案

【问题标题】：How can I speed up this For Each loop in VBA?如何在 VBA 中加快 For Each 循环？
【发布时间】：2019-10-09 12:44:04
【问题描述】：

我有一个 Worksheet_Change 宏，它根据用户在具有数据验证列表的单元格中所做的选择来隐藏/取消隐藏行。

代码需要一分钟才能运行。它循环超过 c.2000 行。我希望它需要几秒钟的时间，以便它成为一个有用的用户工具。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    'Exit the routine early if there is an error
    On Error GoTo EExit

    'Manage Events
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    'Declare Variables
    Dim rng_DropDown As Range
    Dim rng_HideFormula As Range
    Dim rng_Item As Range

    'The reference the row hide macro will look for to know to hide the row
    Const str_HideRef As String = "Hide"

    'Define Variables
    'The range that contains the week selector drop down
    Set rng_DropDown = Range("rng_WeekSelector")
    'The column that contains the formula which indicates if a row should 
    'be hidden c.2000 rows
    Set rng_HideFormula = Range("rng_HideFormula")

    'Working Code
    'Exit sub early if the Month Selector was not changed
    If Not Target.Address = rng_DropDown.Address Then GoTo EExit

    'Otherwise unprotect the worksheet
    wks_DailyPlanning.Unprotect (str_Password)

    'For each cell in the hide formula column
    For Each rng_Item In rng_HideFormula

        With rng_Item
            'If the cell says "hide"
            If .Value2 = str_HideRef Then

                'Hide the row
                .EntireRow.Hidden = True

            Else
                'Otherwise show the row
                .EntireRow.Hidden = False

            End If
        End With
    'Cycle through each cell
    Next rng_Item

    EExit:
    'Reprotect the sheet if the sheet is unprotected
    If wks_DailyPlanning.ProtectContents = False Then wks_DailyPlanning.Protect (str_Password)


    'Clear Events
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True

End Sub

我查看了该网站上其他用户提供的一些链接，我认为问题在于我必须单独遍历每一行。

是否可以创建类似 .visible 设置的数组，我可以一次将其应用于整个范围？

【问题讨论】：

您可以从硬盘与内存的Understanding Read/ Write Speeds 中受益。
如果您在该行的（隐藏）列中有可见计算的结果，则一次性将.autofilter 应用于所有错误值。这比遍历所有这些要快得多。
我喜欢AutoFilter 的想法，或者循环遍历一个数组并使用Union 创建两个范围对象来一次隐藏/取消隐藏。这比遍历项目并一一隐藏/取消隐藏行要快。此外，工作代码可能更适合Code Review =)
此外，如果您需要隐藏行而不是过滤行（有一点不同），那么可以使用.advancedfilter 来完成。 Shameless self plug

标签： excel vba optimization foreach

【解决方案1】：

另一种可能性：

Dim mergedRng As Range

'.......

rng_HideFormula.EntireRow.Hidden = False
For Each rng_Item In rng_HideFormula
    If rng_Item.Value2 = str_HideRef Then
        If Not mergedRng Is Nothing Then
            Set mergedRng = Application.Union(mergedRng, rng_Item)
        Else
            Set mergedRng = rng_Item
        End If
    End If
Next rng_Item
If Not mergedRng Is Nothing Then mergedRng.EntireRow.Hidden = True
Set mergedRng = Nothing

'........

【讨论】：

这对我来说是最快的解决方案。谢谢！
@jakrooster。在 50,000 行上试一试，看看它的真正威力。 :-)

【解决方案2】：

我建议将您的数据范围复制到基于内存的数组中并检查它，然后使用该数据来调整每一行的可见性。它最大限度地减少了您与工作表 Range 对象的交互次数，这会占用大量时间并且对大范围的性能造成很大影响。

Sub HideHiddenRows()
    Dim dataRange As Range
    Dim data As Variant
    Set dataRange = Sheet1.Range("A13:A2019")
    data = dataRange.Value

    Dim rowOffset As Long
    rowOffset = IIf(LBound(data, 1) = 0, 1, 0)

    ApplicationPerformance Flag:=False

    Dim i As Long
    For i = LBound(data, 1) To UBound(data, 1)
        If data(i, 1) = "Hide" Then
            dataRange.Rows(i + rowOffset).EntireRow.Hidden = True
        Else
            dataRange.Rows(i + rowOffset).EntireRow.Hidden = False
        End If
    Next i
    ApplicationPerformance Flag:=True
End Sub

Public Sub ApplicationPerformance(ByVal Flag As Boolean)
    Application.ScreenUpdating = Flag
    Application.DisplayAlerts = Flag
    Application.EnableEvents = Flag
End Sub

【讨论】：

【解决方案3】：

为了提高性能，您可以使用范围地址填充字典，并立即隐藏或取消隐藏，而不是隐藏/取消隐藏每个特定行（但这只是理论上的，您应该自己测试），只是一个例子：

Sub HideHiddenRows()
    Dim cl As Range, x As Long
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")

    x = Cells(Rows.Count, "A").End(xlUp).Row
    For Each cl In Range("A1", Cells(x, "A"))
        If cl.Value = 0 Then dic.Add cl.Address(0, 0), Nothing
    Next cl

    Range(Join(dic.keys, ",")).EntireRow.Hidden = False

End Sub

演示：

【讨论】：