Delete rows using .Range.Find() method

问题

I am trying to find each cell that contains the following value "# Results" and if the cell to the right is == 0 then delete the entire row as well as the row below.

However, since I am deleting rows, the .Range.Find method gets buggy and fails to find the next occurence after the first deletion. How can I make this code work?

Here is the code:

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

Thank you

回答1:

Yes the problem is that if you are deleting rows as you go you will change the address of previously found cells, so store the relevant ranges as you go, and do the deleting at the end:

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

来源：https://stackoverflow.com/questions/59750930/delete-rows-using-range-find-method

标签

excel

vba