Excel VBA基於列中的多個條件刪除整個行

Question

我正在嘗試在excel中爲vba編寫宏。我想刪除在D列（關鍵字爲「INVOICE」，「PAYMENT」或「P.O.」）中沒有至少三個關鍵字中的至少一個的每一行。我需要保持包含這些關鍵字的每一行。所有其他行都需要刪除，剩下的行需要推送到文檔的頂部。還有兩個標題行無法刪除。

我發現了下面的代碼，但它刪除了不包含「INVOICE」的每一行。我無法操作代碼來執行我需要的操作。

Sub Test() 

    Dim ws As Worksheet 
    Dim rng1 As Range 
    Dim lastRow As Long 

    Set ws = ActiveWorkbook.Sheets("*Name of Worksheet") 

    lastRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row 

    Set rng = ws.Range("D1:D" & lastRow) 

    ' filter and delete all but header row 
    With rng 
     .AutoFilter Field:=1, Criteria1:="<>*INVOICE*" 
     .Offset(2, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete 
    End With 

    ' turn off the filters 
    ws.AutoFilterMode = False 

End Sub 

Answer 1

我會對這個循環略有不同。對我來說，這是更容易閱讀。

Sub Test() 

    Dim ws As Worksheet 
    Dim lastRow As Long, i As Long 
    Dim value As String 

    Set ws = ActiveWorkbook.Sheets("*Name of Worksheet") 
    lastRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row 

    ' Evaluate each row for deletion. 
    ' Go in reverse order so indexes don't get messed up. 
    For i = lastRow To 2 Step -1 
     value = ws.Cells(i, 4).Value ' Column D value. 

     ' Check if it contains one of the keywords. 
     If Instr(value, "INVOICE") = 0 _ 
      And Instr(value, "PAYMENT") = 0 _ 
      And Instr(value, "P.O.") = 0 _ 
      Then 

      ' Protected values not found. Delete the row. 
      ws.Rows(i).Delete 
     End If 
    Next 

End Sub 

這裏的關鍵是檢查單元格值內受保護的關鍵字Instr function。如果找不到任何關鍵字，則滿足If條件，並刪除該行。

只需附加If條件即可輕鬆添加其他受保護的關鍵字。

Answer 2

'similar with previous post, but using "like" operator 

Sub test() 
    Dim ws As Worksheet, i&, lastRow&, value$ 
    Set ws = ActiveWorkbook.ActiveSheet 
    lastRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row 
    For i = lastRow To 2 Step -1 
     value = ws.Cells(i, 4).value 
     ' Check if it contains one of the keywords. 
     If Not (value Like "*INVOICE*" _ 
      Or value Like "*PAYMENT*" _ 
      Or value Like "*P.O.*") _ 
      Then 
      ' Protected values not found. Delete the row. 
      ws.Rows(i).Delete 
     End If 
    Next 
End Sub 

Answer 3

' 
Sub test() 
    Dim i& 
    Application.ScreenUpdating = False 
    i = Range("D" & Rows.Count).End(xlUp).Row 
    While i <> 1 
     With Cells(i, 4) 
      If Not (.value Like "*INVOICE*" _ 
       Or .value Like "*PAYMENT*" _ 
       Or .value Like "*P.O.*") _ 
       Then 
       Rows(i).Delete 
      End If 
     End With 
     i = i - 1 
    Wend 
    Application.ScreenUpdating = True 
End Sub 

Answer 4

的方式水淨化處於工作列插入一個IF測試，然後AutoFilter這一點。

這是VBA相當於進入
=SUM(COUNTIF(D1,{"*INVOICE*","*PAYMENT*","*P.O.*"}))=0 ，然後刪除其中沒有這些值在corrresponing D細胞

Sub QuickKill() 
    Dim rng1 As Range, rng2 As Range, rng3 As Range 
    Set rng1 = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious) 
    Set rng2 = Cells.Find("*", , xlValues, , xlByRows, xlPrevious) 
    Set rng3 = Range(Cells(rng2.Row, rng1.Column), Cells(1, rng1.Column)) 

    Application.ScreenUpdating = False 
    Rows(1).Insert 

    With rng3.Offset(-1, 1).Resize(rng3.Rows.Count + 1, 1) 
     .FormulaR1C1 = "=SUM(COUNTIF(RC[-1],{""*INVOICE*"",""*PAYMENT*"",""*P.O.*""}))=0" 
     .AutoFilter Field:=1, Criteria1:="TRUE" 
     .EntireRow.Delete 
     On Error Resume Next 
     'in case all rows have been deleted 
     .EntireColumn.Delete 
     On Error GoTo 0 
    End With 

    Application.ScreenUpdating = True 
End Sub