Vba Autofilter可删除除一组值之外的所有值

Vba Autofilter可删除除一组值之外的所有值,vba,excel,Vba,Excel,我在Excel中使用一个宏,它对一列应用过滤器,选择我不想再保留的值,然后删除它们。我的问题是我的宏要求我知道所有我不想要的值。事实上,我有一个明确的清单,上面有我想要保留的,所有其他的都应该删除。有人能帮我切换这个宏吗?这样我就可以把要保留的值列表传递给它,其他的都被删除了?这是我到目前为止所拥有的 Columns("C:C").Select Selection.AutoFilter Dim LR As Long LR = ActiveSheet.UsedRan

我在Excel中使用一个宏,它对一列应用过滤器,选择我不想再保留的值,然后删除它们。我的问题是我的宏要求我知道所有我不想要的值。事实上,我有一个明确的清单,上面有我想要保留的,所有其他的都应该删除。有人能帮我切换这个宏吗?这样我就可以把要保留的值列表传递给它,其他的都被删除了?这是我到目前为止所拥有的

    Columns("C:C").Select
    Selection.AutoFilter
    Dim LR As Long
    LR = ActiveSheet.UsedRange.Rows.Count
    ActiveSheet.Range("B2:B" & LR).AutoFilter Field:=1, Criteria1:=Array( _
        "A1", "AC", "AV", "BF", "BK", "BR", "C8", "CB", "CG", "CI", "CJ", "CM", "CO", "CR", "CS", "CT" _
        , "DR", "DN", "DS", "DU", "EF", "FC", "FE", "FI", "FO", "GD", "GE", "GO", "GR", "GW", "HA", "HD", _
        "HI", "KH", "KU", "LV", "MI", "MS", "MV", "MZ", "NE", "NO", "P4", "PI", "RS", "RT", "S9", "SC", "SU" _
        , "SY", "TO", "TX", "UR", "VN", "VR", "WI", "WN", "YA", "YO", "ZZ", "AO", "GS", "KR", "F5", "A2", _
        "LD", "ZE", "TG", "MX", "JI", "A9"), _
        Operator:=xlFilterValues
    Rows("2:" & LR).Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter
    Range("A1").Select

使用临时表似乎是可能的

Dim LR As Long
Dim rngDB As Range
Dim Ws As Worksheet, Temp As Worksheet
Set Ws = ActiveSheet
LR = Ws.UsedRange.Rows.Count
Set rngDB = ActiveSheet.Range("B2:B" & LR)
rngDB.AutoFilter Field:=1, Criteria1:=Array( _
    "A1", "AC", "AV", "BF", "BK", "BR", "C8", "CB", "CG", "CI", "CJ", "CM", "CO", "CR", "CS", "CT" _
    , "DR", "DN", "DS", "DU", "EF", "FC", "FE", "FI", "FO", "GD", "GE", "GO", "GR", "GW", "HA", "HD", _
    "HI", "KH", "KU", "LV", "MI", "MS", "MV", "MZ", "NE", "NO", "P4", "PI", "RS", "RT", "S9", "SC", "SU" _
    , "SY", "TO", "TX", "UR", "VN", "VR", "WI", "WN", "YA", "YO", "ZZ", "AO", "GS", "KR", "F5", "A2", _
    "LD", "ZE", "TG", "MX", "JI", "A9"), _
    Operator:=xlFilterValues

Set Temp = Sheets.Add

rngDB.SpecialCells(xlCellTypeVisible).EntireRow.Copy Temp.Range("a1")
Ws.ShowAllData
rngDB.EntireRow.ClearContents

Temp.Range("a1").CurrentRegion.Copy Ws.Range("a2")
Application.DisplayAlerts = False
Temp.Delete
Application.DisplayAlerts = True

如前所述,您可以使用临时工作表来存储正确的值。除此之外,您只需使用
选择案例即可

Sub Filter()
Dim lRow As Long
Dim sht As Worksheet

Set sht = Worksheets("Sheet1")
lRow = sht.Cells(sht.Rows.Count, 2).End(xlUp).Row

If lRow > 1 Then
For i = lRow To 2 Step -1
    Select Case sht.Cells(i, 2).Value
    Case "A1", "AC", "AV", "BF", "BK", "BR", "C8", "CB", "CG", "CI", "CJ", "CM", "CO", "CR", "CS", "CT" _
        , "DR", "DN", "DS", "DU", "EF", "FC", "FE", "FI", "FO", "GD", "GE", "GO", "GR", "GW", "HA", "HD", _
        "HI", "KH", "KU", "LV", "MI", "MS", "MV", "MZ", "NE", "NO", "P4", "PI", "RS", "RT", "S9", "SC", "SU" _
        , "SY", "TO", "TX", "UR", "VN", "VR", "WI", "WN", "YA", "YO", "ZZ", "AO", "GS", "KR", "F5", "A2", _
        "LD", "ZE", "TG", "MX", "JI", "A9"
    Case Else
        sht.Rows(i).Delete
    End Select
Next
End If
End Sub