VBA - скорость сокрытия / отображения строки как события рабочего листа

Question

Я борюсь со скоростью, с которой выполняется следующий код VBA.

Цель этого кода - активировать всякий раз, когда изменяется «C4», а затем сканировать столбец «R» на значение «Y». Если есть буква «Y», то она скрывает строку, а если нет - скрывает строку. Код работает, он просто не быстрый - для 500 строк это может занять 30 или более секунд каждый раз, когда я меняю значение «C4».

У кого-нибудь есть предложения по улучшению скорости выполнения этого кода? Или другой способ сделать это?

Спасибо, что заглянули.

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
• Соберите строки «Скрыть» или «Показать» в диапазоне (объединение) и «Показать / скрыть» за один раз.

---

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