代码之家 › 专栏 › 技术社区 › Sevpoint

在自动筛选中取消选择/排除条件的动态值

vba excel

0

Sevpoint · 技术社区 · 7 年前

我在一张名为“原始”的表格中列出了一系列数据,其中包括不同的动物。在主工作表中,我有一个命名范围“rngAnimals”(动态-用户输入值),在这里我可以列出我想在autofilter中排除的值,并显示剩余的数据。

数据示例:

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

| 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 回复 | 直到 7 年前

1

Shai Rado 7 年前

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

修改代码

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