как я могу ускорить петли

Question

Он работает просто отлично, но выполнение медленнее, чем хотелось бы, и я не уверен, почему.У меня есть другой сегмент кода, который также меняет это ...

Есть только 5 листов, через которые он проходит, и только в заданном диапазоне загрузки.Это только проверка на нулевое значение в столбце А, и если оно равно нулю, строка скрывается.

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

    Sub HideBlanks()
    Dim Sheet As Worksheet
    Dim r As Long

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    For Each Sheet In Worksheets
        If Sheet.Index > 1 Then
            With Sheet
                For r = 4 To 350
                    With activesheets
                        If Range("A" & r) = "" Then
                            Range("A" & r).EntireRow.Hidden = True
                        End If
                    End With
                Next r
            End With
        End If
        Range("a1").Select
    Next Sheet

    Worksheets(1).Activate

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

    End Sub

Может быть, я полностью ошибаюсь ...

Конечная цель - спрятаться (или предотвратить) пустые ячейки между A4: G350 от печати этих строк, если значение равно "".

Answer 1

Может попробовать

 Sub HideBlanks()
    Dim Ws As Worksheet
    Dim Rw As Long
    Dim Arr As Variant, Rng As Range

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Index > 1 Then
        Arr = Ws.Range("A4:A350").Value
          For Rw = LBound(Arr) To UBound(Arr)
            If Arr(Rw, 1) = "" Then
                If Rng Is Nothing Then
                Set Rng = Ws.Range("A" & Rw + 3)
                Else
                Set Rng = Union(Rng, Ws.Range("A" & Rw + 3))
                End If
             End If
            Next Rw
        End If
   If Not Rng Is Nothing Then Rng.EntireRow.Hidden = True
   Set Rng = Nothing
   Next Ws

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

    End Sub