Excel VBA根據一列中的多個條件刪除整行

Question

我試圖在VBA中為Excel編寫宏。 我想刪除D列中至少沒有三個關鍵字之一的每一行（關鍵字為“ INVOICE”，“ PAYMENT”或“ PO”）。 我需要保留包含這些關鍵字的每一行。 所有其他行都需要刪除，剩余的行需要推到文檔的頂部。 還有兩個標題行不能刪除。

我在下面找到了代碼，但它刪除了僅不包含“ 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函數 ，該函數檢查單元格值內您受保護的關鍵字。 如果找不到任何關鍵字，則滿足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*","*PO*"}))=0 ，然后刪除在相應的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