Excel VBA根据列中的多个条件删除整行

我正在尝试写一个macros的VBA为Excel。 我想删除D列中没有至less三个关键字中的至less一个（关键字是“INVOICE”，“PAYMENT”或“PO”）的每一行。 我需要保持包含这些关键字的每一行。 所有其他行都需要被删除，剩下的行需要被推到文档的顶部。 还有两个标题行不能被删除。

我find了下面的代码，但它删除了不包含“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, "PO") = 0 _ Then ' Protected values not found. Delete the row. ws.Rows(i).Delete End If Next End Sub 

这里的关键是Instr函数 ，它检查单元格值中的受保护关键字。 如果没有find任何关键字，则满足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 "*PO*") _ 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 "*PO*") _ Then Rows(i).Delete End If End With i = i - 1 Wend Application.ScreenUpdating = True End Sub 

Answer 4

其他方法是在工作列中插入一个IFtesting，然后是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*"",""*PO*""}))=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