Что я могу сделать, чтобы улучшить свой код VBA?

Question

Я написал макрос VBA для автоматического удаления некоторых строк. Не знаю, почему он никогда не прекращает обработку.

Может ли это быть ошибкой в ​​моем коде?

Цените любую помощь.

Sub AutoProcess()

Application.ScreenUpdating = False
Application.Calculation = xlManual

Dim Row, RowCount

RowCount = ActiveSheet.UsedRange.Rows.Count

For Row = 3 To RowCount
    If ActiveSheet.Cells(Row, 7).Value = 0 And ActiveSheet.Cells(Row, 9).Value = 0 Then
        Rows(Row).Delete
        RowCount = ActiveSheet.UsedRange.Rows.Count
        Row = Row - 1
    End If
Next Row

MsgBox ("finished")

Application.Calculate
Application.ScreenUpdating = True

End Sub

Answer 1

Попробуйте использовать объединение для скорости

Sub Delete_Rows_Using_Loops()
    Dim ws As Worksheet, r As Long, c As Range

    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        Set ws = ThisWorkbook.Sheets("Sheet1")

        For r = ws.UsedRange.Rows.Count To 3 Step -1
            If ws.Cells(r, 7).Value = 0 And ws.Cells(r, 9).Value = 0 Then
                If c Is Nothing Then Set c = ws.Rows(r) Else Set c = Union(c, ws.Rows(r))
            End If
        Next r

        If Not c Is Nothing Then c.Delete
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

    MsgBox "Finished", 64
End Sub

Другим более быстрым подходом является использование автофильтра. Предположим, что заголовки в строке 2

Sub Delete_Rows_Using_AutoFilter()
    Dim ws As Worksheet

    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        Set ws = ThisWorkbook.Worksheets("Sheet1")

        With ws.Range("G2:I" & ws.Cells(Rows.Count, 7).End(xlUp).Row)
            .AutoFilter 1, "="
            .AutoFilter 3, "="
            If .Columns(1).SpecialCells(12).Count > 1 Then
                .Offset(1).Resize(.Rows.Count - 1).Delete xlShiftUp
            End If
            .AutoFilter
        End With
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

    MsgBox "Finished", 64
End Sub

И вот третий подход, использующий Evaluate для получения удаляемых строк

Sub Delete_Rows_Using_Evaluate()
    Dim x, ws As Worksheet, r As Range

    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        Set ws = ThisWorkbook.Sheets("Sheet1")

        With ws
            Set r = .Range("G3:G" & .Cells(Rows.Count, 7).End(xlUp).Row)
            x = Filter(.Evaluate("TRANSPOSE(IF((" & r.Address & "=0)+(" & r.Offset(, 2).Address & "=0),""A"" & ROW(" & r.Address & ")))"), False, False)
            If UBound(x) = -1 Then Exit Sub
            .Range(Join(x, ",")).EntireRow.Delete
        End With
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

Answer 2

For Row = RowCount to 3 Step -1
    If ActiveSheet.Cells(Row, 7).Value = 0 And ActiveSheet.Cells(Row, 9).Value = 0 Then
        Rows(Row).EntireRow.Delete
    End If
Next Row

Answer 3

При этом используется фильтр, а не зацикливание.
Я также использовал .Cells(.Rows.Count, 1).End(xlUp).Row вместо UsedRange, поскольку он может возвращать неверные результаты.

Sub Test()

    Dim wrksht As Worksheet
    Dim lLastRow As Long

    Set wrksht = ThisWorkbook.Worksheets("Sheet1")
    With wrksht
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Finds last row in column A containing data.
        With .Range("A3", .Cells(lLastRow, 9))
            .AutoFilter
            .AutoFilter Field:=7, Criteria1:="0"
            .AutoFilter Field:=9, Criteria1:="0"
        End With
       .Range("A4", .Cells(lLastRow, 9)).SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
       .AutoFilterMode = False
    End With

End Sub

Answer 4

вы можете использовать столбец "помощник" и формулу

With Range(Cells(3, 7), Cells(Rows.Count, 7).End(xlUp))
    With .Offset(, .Parent.UsedRange.Columns.Count)
        .FormulaR1C1 = "=IF(SUM(RC7,RC9)=0,1,"""")"
        .SpecialCells(xlCellTypeFormulas, xlNumbers).EntireRow.Delete
        .Delete
    End With
End With