Удалить строки с помощью метода .Range.Find ()

Question

Я пытаюсь найти каждую ячейку, которая содержит следующее значение «# Results», и если ячейка справа равна == 0, то удалите всю строку, а также строку ниже.

Однако, так как я удаляю строки, метод .Range.Find глючит и не может найти следующий случай после первого удаления. Как я могу заставить этот код работать?

Вот код:

sub KillEmptyResults()

Dim sRows As Range
Dim X As Range

Set X = Nothing
SearchStr = Chr(35) & " Results"
With ActiveSheet.UsedRange
    Set X = .Cells.Find(What:=SearchStr, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlRows, SearchDirection:=xlPrevious, MatchCase:=False)
        If Not X Is Nothing Then
        sFirstAddress = X.address
        Do
            'Transform anchor row to entire range to delete
            If X.Offset(0, 1).Value = "0" Then
                Set sRow = Rows(X.Row).EntireRow
                Set sRows = sRow.Resize(sRow.Rows.Count + 1, sRow.Columns.Count)
                sRows.Delete
            End If
            Set X = .FindNext(X)
        Loop While Not X Is Nothing And X.address <> sFirstAddress
        End If
End With

End Sub

Спасибо

Answer 1

Да, проблема в том, что если вы удаляете строки как go, вы измените адрес ранее найденных ячеек, поэтому сохраните соответствующие диапазоны как go и выполните удаление в конце:

Sub KillEmptyResults()

Dim sRows As Range
Dim X As Range, sFirstAddress As String, SearchStr As String, rDelete As Range

SearchStr = Chr(35) & " Results"

With ActiveSheet.UsedRange
    Set X = .Cells.Find(What:=SearchStr, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlRows, SearchDirection:=xlPrevious, MatchCase:=False)
        If Not X Is Nothing Then
            sFirstAddress = X.Address
            Do
                'Transform anchor row to entire range to delete
                If X.Offset(0, 1).Value = 0 Then
                    If rDelete Is Nothing Then 'establish range to be deleted
                        Set rDelete = X.Resize(2).EntireRow
                    Else
                        Set rDelete = Union(rDelete, X.Resize(2).EntireRow)
                    End If
                End If
                Set X = .FindNext(X)
            Loop While X.Address <> sFirstAddress
        End If
End With

If Not rDelete Is Nothing Then rDelete.Delete

End Sub