在自动过滤器中取消选择/排除标准的动态值

时间:2019-01-15 13:14:58

标签: excel vba

我在名为“原始”的工作表中有一个数据列表,该表由不同的动物组成。在主工作表中,我有一个命名范围“ rngAnimals”(动态-用户输入值),在其中可以列出要在自动过滤器中排除的值,并显示其余数据。

示例数据:

| Animal   |
|----------|
| Dog      |
| Cat      |
| Bird     |
| Elephant |
| Horse    |
| Dog      |
| Dog      |
| Cat      |
| Bird     |
| Elephant |
| Horse    |
| Dog      |

在命名范围“ rngAnimals”中,我指定了要在自动过滤器中排除的值:

| Dog      |
| Cat      |

我有一个有效的代码,但是它却相反(显示我指定的值)。

Sub UnselectCritera()


Dim vCrit As Variant
Dim inputSheet As Worksheet
Dim mainSheet As Worksheet

Dim rngCrit As Range
Dim rngOrders As Range

Set inputSheet = Worksheets("raw")
Set mainSheet = Worksheets("Main")

Set rngOrders = inputSheet.Range("$A$1").CurrentRegion
Set rngCrit = mainSheet.Range("rngAnimals")



vCrit = rngCrit.Value
rngOrders.AutoFilter _
Field:=1, _
Criteria1:=Application.Transpose(vCrit), _
Operator:=xlFilterValues

End Sub

我试图将“ =”更改为“ <>”,但这给了我一个错误:

rngOrders.AutoFilter _
Field:=1, _
Criteria1:="<>" & Application.Transpose(vCrit), _
Operator:=xlFilterValues

还有其他方法可以排除执行自动过滤时显示的值吗?

1 个答案:

答案 0 :(得分:1)

按照我在上面的注释中的建议,尝试以下代码,并在代码的注释中进行解释:

修改后的代码

Option Explicit

Sub UnselectCritera()

Dim inputSheet As Worksheet
Dim mainSheet As Worksheet
Dim rngCrit As Range
Dim rngOrders As Range

' Dictionary variables
Dim Dict As Object, Key As Variant
Dim AnimalArr() As String, ArrIndex As Long, LastRow As Long, i As Long

Set inputSheet = Worksheets("raw")
Set mainSheet = Worksheets("Main")

Set rngOrders = inputSheet.Range("$A$1").CurrentRegion
Set rngCrit = mainSheet.Range("rngAnimals")

' use a Dictionary ro save unique Order numbers
Set Dict = CreateObject("Scripting.Dictionary")

Application.ScreenUpdating = False

With inputSheet
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    ArrIndex = 1

    ReDim AnimalArr(1 To 10000) ' redim to very large number >> will optimize later
    For i = 1 To LastRow
       If Not Dict.Exists(.Range("A" & i).Value2) Then  ' current animal not in Dictionary >> add it as key
            ' check also that Animal is not in the second list
            If IsError(Application.Match(.Range("A" & i).Value2, rngCrit, 0)) Then ' Match failed >> not in second list of animals
                Dict.Add .Range("A" & i).Value2, .Range("A" & i).Value ' add Order number / Customer / Status

                ' array of numbers
                AnimalArr(ArrIndex) = .Range("A" & i).Value2
                ArrIndex = ArrIndex + 1
            End If
       End If
    Next i

    ReDim Preserve AnimalArr(1 To ArrIndex - 1) ' resize array to populated size
End With

' Filter according to Animal array (excluding the animals in the second list)
rngOrders.AutoFilter Field:=1, Criteria1:=AnimalArr, Operator:=xlFilterValues

Application.ScreenUpdating = True

End Sub