使用 删除行.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