Массив автофильтра не работает с большим количеством элементов VBA

Question

Я здесь, потому что (почти два дня) я пишу код и мне нужна помощь.

Цель моего сценария - отфильтровать строки, у которых нет номера в столбце "Check_Column".

Проблема в том, что фильтр не работает "хорошо" (пахнет, что он работает наполовину).

Мой код:

Sub hide_numbers()
Dim WorkBk As Workbook, WorkSh As Worksheet, FilterRow As Variant
Set WorkSh = Sheets("DataBase")
WorkSh.Activate
FilterRow = Rows("1:1").Find(what:="Check_Column", lookat:=xlWhole).Column
WorkSh.UsedRange.AutoFilter Field:=FilterRow, Criteria1:=Array("*1*","*2*","*3*","*4*","*5*","*6*", "*7*","*8*","*9*")
End Sub

Если я использую (*1*","*2*"), это работает, но если я использую ("*1*","*2*","*3*","*4*","*5*","*6*", "*7*","*8*","*9*"), это не работает. Почему?

Вот снимок экрана Excel (пример).

Я хотел бы получить этот вывод (этопример).

Кто-нибудь, пожалуйста, подскажите, в чем я не прав?

Заранее благодарен.

Francesco

Answer 1

Следующий макрос использует объект Dictionary для сбора уникальных значений из Check_Column, который содержит цифру, и затем фильтрует эти значения.

Кстати, поскольку вы хотите показать строки, в которых значение в Check_Columnсодержит цифру, вероятно, было бы более целесообразно изменить имя подпрограммы с hide_numbers на show_numbers.

Option Explicit

Sub hide_numbers()

    Dim criteriaDictionary As Object
    Set criteriaDictionary = CreateObject("Scripting.Dictionary")

    Dim criteriaArray As Variant
    criteriaArray = Array("*1*", "*2*", "*3*", "*4*", "*5*", "*6*", "*7*", "*8*", "*9*")

    Dim databaseWorksheet As Worksheet
    Set databaseWorksheet = Worksheets("DataBase")

    With databaseWorksheet

        Dim fieldIndex As Long
        fieldIndex = .Rows("1:1").Find(what:="Check_Column", lookat:=xlWhole).Column

        Dim currentCell As Range
        Dim currentItem As Variant
        For Each currentCell In .Range(.Cells(2, fieldIndex), .Cells(.Rows.Count, fieldIndex).End(xlUp)).Cells
            For Each currentItem In criteriaArray
                If currentCell.Value Like currentItem Then
                    criteriaDictionary(currentCell.Value) = ""
                    Exit For
                End If
            Next currentItem
        Next currentCell

        If criteriaDictionary.Count > 0 Then
            With .UsedRange
                .AutoFilter field:=fieldIndex, Criteria1:=criteriaDictionary.keys(), Operator:=xlFilterValues
            End With
        Else
            MsgBox "No records found!", vbExclamation
        End If

    End With

    Set criteriaDictionary = Nothing
    Set databaseWorksheet = Nothing

End Sub

Answer 2

MS Excel не поддерживает подстановочные знаки в значениях массива. Либо вы можете создать массив всех значений с числами и использовать следующий код:

WorkSh.UsedRange.AutoFilter Field:=FilterRow, Criteria1:=myArray, Operator:=xlFilterValues

, либо вы можете добавить новый столбец в свой набор данных, содержащий значение True / False для соответствующих строк с некоторой формулой иупростите ваш код следующим образом:

WorkSh.UsedRange.AutoFilter Field:=FilterRow, Criteria1:=True