Как ускорить код VBA для сокрытия строк?

Question

С VBA я создал кнопку переключения, которая скрывает и отображает строки, однако это действительно медленно. Чтобы скрыть 200 строк, нужно примерно 2 минуты. Есть ли способ ускорить этот код? Моя цель будет меньше 10 секунд, если это вообще возможно.

Вот мой код:

Option Explicit

Private Sub ToggleButton1_Click()

Dim bHide As Boolean
Dim rCell As Range
bHide = ToggleButton1.Value

Application.ScreenUpdating = False
Application.EnableEvents = False

For Each rCell In Range("AC10:AC800")
If rCell.Value = 1 Then
If Not rCell Is Nothing Then
Rows(rCell.Row).Hidden = bHide
End If
End If
Next 

Application.ScreenUpdating = True
Application.EnableEvents = True 

End Sub

Спасибо за любую помощь!

Answer 1

В VBA чтение и запись на рабочие листы являются самым большим убийцей времени. Таким образом, вы хотите свести к минимуму частоту взаимодействия с рабочими листами.

К счастью, вы можете читать несколько значений или скрывать несколько строк в одной команде вместо использования команды для каждого отдельного значения или строки.

Примерно так:

Private Sub ToggleButton1_Click()
    Dim ws As Worksheet
    Dim rangeToCheck As Range
    Dim rangeToHide As Range
    Dim sheetData() As Variant
    Dim curRow As Long

    Set ws = ThisWorkbook.Sheets("Sheet1") 'Change to your worksheet name
    Set rangeToCheck = ws.Range("AC10:AC800")

    sheetData = rangeToCheck.Value  'Read all data from the range into an array at once

    For curRow = LBound(sheetData) To UBound(sheetData)
        If sheetData(curRow, 1) = 1 Then 'Check contents of each row, and add to range to hide if the check is true
            If rangeToHide Is Nothing Then
                Set rangeToHide = rangeToCheck.Rows(curRow).EntireRow
            Else
                Set rangeToHide = Union(rangeToHide, rangeToCheck.Rows(curRow).EntireRow)
            End If
        End If
    Next curRow

    'If at least one row was found, hide all rows at once
    If Not rangeToHide Is Nothing Then rangeToHide.EntireRow.Hidden = ToggleButton1.Value
End Sub

Answer 2

Я думаю, что использование автофильтра - это самый быстрый метод, требующий более короткого фрагмента кода.

Private Sub rngFilterHide()
  Dim sh As Worksheet, sR As Range, rngHhide As Range

    Set sh = ActiveSheet 'Use here your sheet name
    Set sR = sh.Range("AC10:AC800")
    sR.AutoFilter field:=1, Criteria1:="=1", VisibleDropDown:=False
      Set rngHhide = sR.SpecialCells(xlCellTypeVisible)
      sh.AutoFilterMode = False
      rngHhide.EntireRow.Hidden = ToggleButto1.Value
      If sh.Range("AC10") <> 1 Then sh.Rows("10:10").Hidden = Not ToggleButto1.Value
End Sub

Answer 3

Другой способ - просто собрать адрес. В принятом ответе вам постоянно нужно проверять If rangeToHide Is Nothing. Однако в этом методе вам не нужно это делать.

Sub HideUnhide()
    Dim addr, cell
    For Each cell In [AC10:AC800]
        If cell = 1 Then addr = addr & cell.Address(0, 0) & ","
    Next
    If Len(addr) > 0 Then
        addr = Left$(addr, Len(addr) - 1) '//Get rid of last comma
        Range(addr).EntireRow.Hidden = ToggleButto1.Value
    End If
End Sub