VBA-隐藏速度/不向行作为工作表事件

Question

我正在为执行以下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

Answer 1

在代码开头添加 Application.EnableEvents = False，然后回到true会有所帮助，也使用Applciation.ScreenUpdating = 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

Answer 2

有几种技术可以帮助加速

• 写信给.Hidden的速度比阅读它要慢得多。因此，在设置Hidden
之前，检查行是否已经隐藏或显示
• 收集行以隐藏或显示为范围（联合），然后一口气隐藏/显示tehm。

---

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