vba Excel VBA根据列中的多个条件删除整行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/27868706/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA deleting entire row based on multiple conditions in a column
提问by Matthew Bershok
I am trying to write a macro in vba for excel. I want to delete every row that does not have at least one of three keywords in column D (keywords being "INVOICE", "PAYMENT", or "P.O."). I need to keep every row that contains these keywords. All other rows need to be deleted and the rows remaining need to be pushed to the top of the document. There are also two header rows that can not be deleted.
我正在尝试在 vba 中为 excel 编写一个宏。我想删除在 D 列中没有至少三个关键字之一的每一行（关键字是“INVOICE”、“PAYMENT”或“PO”）。我需要保留包含这些关键字的每一行。需要删除所有其他行，并将剩余的行推送到文档的顶部。还有两个标题行不能删除。
I found the code below but it deletes every row that does not contain "INVOICE" only. I can not manipulate the code to do what I need it to do.
我找到了下面的代码，但它只删除了不包含“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
回答by Jason Faulkner
I would approach this loop slightly different. To me this is a bit easier to read.
我会稍微不同地处理这个循环。对我来说，这更容易阅读。
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
The key here is the Instrfunctionwhich checks for your protected keywords within the cell value. If none of the keywords are found then the Ifcondition is satisfied and the row is deleted.
这里的关键是Instr功能这对于细胞值内受保护的关键字检查。如果未找到任何关键字，If则满足条件并删除该行。
You can easily add additional protected keywords by just appending to the Ifconditions.
您只需附加到If条件即可轻松添加其他受保护的关键字。
回答by Jason Faulkner
'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
回答by Jason Faulkner
'
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
回答by brettdj
The othe way is to insert an IFtest in a working column, and then AutoFilterthat.
另一种方法是IF在工作列中插入一个测试，然后AutoFilter。
This is the VBA equivalent of entering=SUM(COUNTIF(D1,{"*INVOICE*","*PAYMENT*","*P.O.*"}))=0and then deleting any row where none of these values are found in the corrresponing Dcell
这是输入=SUM(COUNTIF(D1,{"*INVOICE*","*PAYMENT*","*P.O.*"}))=0然后删除在相应D单元格中找不到这些值的任何行的 VBA 等效项
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
