Excel VBA-将行隐藏/取消隐藏为工作表事件的速度

我正在与以下VBA代码的执行速度作斗争

此代码的目标是在“C4”更改时激活，然后扫描“R”列中的值“Y”。如果有“Y”，则隐藏该行，如果没有，则取消隐藏该行。代码可以工作，只是速度不快——对于500行，每次我更改“C4”的值可能需要30秒或更长的时间

有人对提高代码执行速度有什么建议吗？还是另一种实现这一点的方法

谢谢你看

Private Sub Worksheet_Change(ByVal Target As Range)

Dim L As Long
Dim r As Range

L = Cells(Rows.Count, "R").End(xlUp).Row

If Not Intersect(Target, Range("C4")) Is Nothing Then
    For Each r In Range("R2:R" & L)
        If r.Value = "Y" Then
            Rows(r.Row).Hidden = True
        Else
            Rows(r.Row).Hidden = False
        End If
    Next
End If

End Sub

在尝试应用下面的建议时-使用Union（）-我想出了下面的代码，但不起作用。任何帮助都将不胜感激

Private Sub Worksheet_Change(ByVal Target As Range)

Dim L As Long
Dim r As Range
Dim RowsToHide As Range
Dim RowsToUnhide As Range

L = Cells(Rows.Count, "R").End(xlUp).Row

If Not Intersect(Target, Range("C4")) Is Nothing Then
    For Each r In Range("R2:R" & L)
        If r.Value = "Y" Then
            RowsToHide = Union(RowsToHide, r.Row)
        Else
            RowsToUnhide = Union(RowsToUnhide, r.Row)
        End If
    Next
End If

RowsToHide.Hidden = True
RowsToUnhide.Hidden = False

End Sub

---

在代码开头添加

Application.EnableEvents=False

，然后返回true将有帮助，使用

Application.screenUpdatement=False

也会有帮助

Private Sub Worksheet_Change(ByVal Target As Range)

Dim L As Long
Dim r As Range

Application.EnableEvents = False
Application.ScreenUpdating = False

L = Cells(Rows.Count, "R").End(xlUp).Row

If Not Intersect(Target, Range("C4")) Is Nothing Then
    For Each r In Range("R2:R" & L)
        If r.Value = "Y" Then
            Rows(r.Row).Hidden = True
        Else
            Rows(r.Row).Hidden = False
        End If
    Next
End If

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

---

有几种技术可以帮助加快这一速度

• 写入

  .Hidden

  比读取要慢得多。因此，在设置

  hidden

• 将要隐藏或显示的行收集到一个范围（并集）中，并一次性隐藏/显示tehm

---

---

@JvdV对不起，我是新来的。我应该把这个贴到别的地方吗？您是否能够提供任何代码或资源，以便了解如何合并范围，然后立即隐藏/取消隐藏？你说得对，我确实同意应该提高速度。通常情况下，帮助他人解决代码中的错误更是如此，但社区将决定这个问题是否偏离主题。此外，我还将研究使用

应用程序。Union

函数对需要隐藏的所有行进行分组，因为这也可能有助于提高性能。我建议研究

自动筛选
@valantic这样的问题，要求进行某种程度的代码审查，这并不是离题的，因此。所以，请不要觉得你必须将它移动到CR。但是如果你确实在CR上发布它，一定要遵循他们的规则。@chrisneilsen下面的回答是最好的解决方案。谢谢大家的帮助！事实上，我在发布我的问题后才添加了这些！这确实有帮助，但没有达到我想要的程度。运行仍然需要20秒。谢谢你的贡献！我还将使用
应用程序进行查找。Union
函数将需要隐藏的所有行合并到一个组中，然后隐藏它们。谢谢，这绝对是我认为我需要遵循的方向。然而，我不知道发生了什么。我粘贴了这段代码（将intersect范围更改为“C4”，这是触发Y/N填充到列R中的单元格），但似乎没有执行任何操作。没有隐藏/未隐藏的行。您是否能够帮助进行故障排除？我能够使大多数代码作为模块子例程工作，但似乎只是无法从工作表事件中执行代码。好消息是，代码几乎在瞬间完成！！您需要将代码放入相关的工作表模块中，或者如果您将代码放入std模块中，请将
Me
s更改为有效的工作表引用是的，我将代码放入相关的工作表模块中，但它似乎从未执行过。在故障排除过程中，我将其放入一个标准模块，并将“Me”更改为有效的工作表引用，它很快就工作了。我更喜欢在工作表模块中使用它，虽然是从工作表事件执行的，但我不明白为什么它不是从更改“C4”开始执行的。C4值是如何更改的？如果它是一个公式，那么它不会触发更改事件
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    Dim rngCheck As Range
    Dim rngHide As Range, rngShow As Range

    Application.ScreenUpdating = False
    If Not Intersect(Target, Me.Range("C1")) Is Nothing Then
        Set rngCheck = Me.Range(Me.Cells(1, "R"), Me.Cells(Me.Rows.Count, "R").End(xlUp))
        For Each r In rngCheck.Cells
            If r.Value2 = "Y" Then
                If Not r.EntireRow.Hidden Then
                    If rngHide Is Nothing Then
                        Set rngHide = r.EntireRow
                    Else
                        Set rngHide = Union(rngHide, r.EntireRow)
                    End If
                End If
            Else
                If r.EntireRow.Hidden Then
                    If rngShow Is Nothing Then
                        Set rngShow = r.EntireRow
                    Else
                        Set rngShow = Union(rngShow, r.EntireRow)
                    End If
                End If
            End If
        Next
    End If

    If Not rngHide Is Nothing Then
        rngHide.EntireRow.Hidden = True
    End If
    If Not rngShow Is Nothing Then
        rngShow.EntireRow.Hidden = False
    End If

    Application.ScreenUpdating = True

End Sub