自动过滤除去所有EXCEPT一组值

时间:2017-07-06 07:32:17

标签: excel vba excel-vba

我在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

2 个答案:

答案 0 :(得分:0)

使用临时表似乎是可能的。

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

答案 1 :(得分:0)

如前所示,您可以使用临时表来存储正确的值。除此之外,您可以使用select case进行调整。

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