excel - AutoFilter Array 不适用于更多元素 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屏幕截图（是一个例子）。

我想要这个输出（是一个例子）。

请有人告诉我我错在哪里？

预先感谢。

弗朗切斯科

标签： excelvba

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