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

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

2 个答案: