VBA脚本筛选保留指定值删除其余行的问题求助

Let's break down what's going wrong with your current code and fix it step by step.

Why Your Existing Methods Fail #

1. Dual Criteria with xlAnd Logic Error #

Your first attempt uses:

.AutoFilter Field:=1, Criteria1:="<>*Apple*", Operator:=xlAnd, Criteria2:="<>*Banana*"

This logic filters rows that neither contain Apple nor Banana—which includes Orange rows too! Those Orange rows get deleted, which is the opposite of what you want.

2. Array Criteria Misunderstanding #

When you use Criteria1:=Array("<>Apple", "<>Banana", "<>Orange") with the default Operator:=xlFilterValues, Excel applies an OR logic: it keeps any row that matches any of the criteria. Since almost every row meets this (e.g., an Apple row is "not Banana" and "not Orange"), you end up with unexpected results like only Orange rows remaining.

Correct Solutions #

We need to target rows that don't contain Apple, Banana, or Orange at all and delete them. Here are two reliable approaches:

Method 1: Use a Formula as Filter Criteria #

This uses an Excel formula to identify rows missing all three target values, then filters and deletes them:

Sub RMWO_Clean()
    Dim ws As Worksheet
    Dim lastRow As Long
    
    Set ws = ActiveWorkbook.Sheets("Sheet1")
    lastRow = ws.Range("Q" & ws.Rows.Count).End(xlUp).Row
    
    ' Keep your existing TextToColumns logic
    ws.Columns("AF:AF").TextToColumns _
        Destination:=ws.Range("AA1"), _
        DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, _
        Tab:=True, _
        Semicolon:=False, _
        Comma:=False, _
        Space:=False, _
        Other:=False, _
        FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
    
    ' Filter rows that don't contain any of the three target values
    With ws.Range("Q1:Q" & lastRow)
        .AutoFilter Field:=1, _
            Criteria1:="=NOT(ISNUMBER(SEARCH(""Apple"",Q1))) * NOT(ISNUMBER(SEARCH(""Banana"",Q1))) * NOT(ISNUMBER(SEARCH(""Orange"",Q1)))", _
            Operator:=xlFilterValues
        
        ' Delete visible rows (skip header)
        On Error Resume Next ' Prevent error if no rows match
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        On Error GoTo 0
    End With
    
    ' Turn off autofilter
    ws.AutoFilterMode = False
End Sub

The formula works like this:

• SEARCH("Apple",Q1) checks if the cell contains Apple (case-insensitive)
• NOT(ISNUMBER(...)) reverses the result to True if the value is missing
• Multiplying the three results acts as an AND logic—only rows missing all three values get filtered.

Method 2: Reverse Filter (Keep Target Rows, Delete Others) #

This approach filters the rows you want to keep, hides them, then deletes everything else:

Sub RMWO_Clean_Alternative()
    Dim ws As Worksheet
    Dim lastRow As Long
    
    Set ws = ActiveWorkbook.Sheets("Sheet1")
    lastRow = ws.Range("Q" & ws.Rows.Count).End(xlUp).Row
    
    ' Keep your existing TextToColumns logic
    ws.Columns("AF:AF").TextToColumns _
        Destination:=ws.Range("AA1"), _
        DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, _
        Tab:=True, _
        Semicolon:=False, _
        Comma:=False, _
        Space:=False, _
        Other:=False, _
        FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
    
    ' Filter rows that contain Apple, Banana, or Orange
    With ws.Range("Q1:Q" & lastRow)
        .AutoFilter Field:=1, _
            Criteria1:=Array("*Apple*", "*Banana*", "*Orange*"), _
            Operator:=xlFilterValues
        
        ' Hide the rows we want to keep, then delete unhidden rows
        ws.Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Hidden = True
        ws.Rows("2:" & lastRow).SpecialCells(xlCellTypeHidden).EntireRow.Delete
    End With
    
    ' Turn off autofilter
    ws.AutoFilterMode = False
End Sub

This is more intuitive: it isolates the rows you want to keep, hides them, then removes everything that's left visible.

Extra Tips #

• Use FIND instead of SEARCH if you need case-sensitive matching.
• The On Error Resume Next line prevents crashes if there are no rows to delete.
• AutoFilter is much faster than looping through rows for large datasets.

内容的提问来源于stack exchange，提问作者Blackbutterfly