Отключить / исключить динамические значения для критериев в автофильтре

Question

У меня есть список данных на листе, называемый «сырой», который состоит из разных животных. На главном листе у меня есть именованный диапазон «rngAnimals» (Dynamic - User entry values), где я могу перечислить значения, которые я хотел бы исключить в автофильтре, и показать оставшиеся данные.

Пример данных:

| 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

Есть ли альтернативный способ, чтобы я мог исключить значения, перечисленные в списке при выполнении автофильтра?

Answer 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