Question

我正在尝试在vba中为excel写一个宏。我想删除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 然后删除在相应的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

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

4 个答案: