如何在刪除整行時添加多個條件？

Question

我搜索已經和我沒有運氣找到正確的答案或創建我的代碼：

此代碼將刪除包含在山口D.「蘋果」整行

我將如何添加條件在strSearch？我想添加「香蕉」和「貓」？

Sub Delete_EntireRow_Values() 
' 
' Delete_EntireRow_Values Macro 

Dim rFind As Range 
Dim rDelete As Range 
Dim strSearch As String 
Dim sFirstAddress As String 

strSearch = "apple" 

Set rDelete = Nothing 

Application.ScreenUpdating = False 

With Sheet1.Columns("D:D") 
    Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False) 
    If Not rFind Is Nothing Then 
     sFirstAddress = rFind.Address 
     Do 
      If rDelete Is Nothing Then 
       Set rDelete = rFind 
      Else 
       Set rDelete = Application.Union(rDelete, rFind) 
      End If 
      Set rFind = .FindNext(rFind) 
     Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress 

     rDelete.EntireRow.Delete 

    End If 
End With 
Application.ScreenUpdating = True 
End Sub 

Answer 1

一種更有效的方式是使用自動篩選，並通過字的陣列，以刪除

Sub DeleteMatchingCriteria() 
Application.ScreenUpdating = False 
    Dim toDelete As Variant 

    ' set the words to delete 
    toDelete = Array("apple", "cat", "bannana") 

    Dim colD As Range 
    Set col = Sheet1.Range("D1:D" & Sheet1.Range("D" & Rows.Count).End(xlUp).Row) 

    With col 
     .AutoFilter Field:=1, Criteria1:=toDelete, Operator:=xlFilterValues 
     .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete 
    End With 

    Sheet1.AutoFilterMode = False 
End Sub