使用 .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

是的，问题是，如果您正在删除行，您将更改先前找到的单元格的地址，因此请随时存储相关范围，并在最后进行删除：

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