自动过滤单元格包含确切的特定数字

Question

我有一个列，其值类似于以下示例：

尺寸
4
1*4
1*24
4*1
4.5*10
2*14*5
3*4*5

我需要设置一个过滤器来获取包含特定数字的单元格，例如“4”，

预期结果为( 4 , 1*4 , 4*1 , 3*4*5)。

如果我使用通配符“ *4*”作为条件，那么它将给我所有包含“ 4”（如（1*24 , 4.5*10））的值，但这不是必需的。
下面的代码只找到以我的号码开头的单元格：

Sub AutoFilter_on_number()

    Dim ws As Worksheet, rng As Range

    Const filterColumn As Long = 29  'column "AC"
    
    Set ws = ActiveSheet
    
    Set rng = ws.Range("A2:AH7000")
    
    rng.AutoFilter Field:=filterColumn, Criteria1:="=4*", Operator:=xlFilterValues
    
End Sub

Answer 1

自动过滤号码

Sub AutoFilterOnNumber()

    ' Define constants.
    
    Const F_COLUMN As Long = 29
    Const F_CRITERION As String = "4"
    Const F_DELIMITER As String = "*"
    
    ' Reference the table range.
    
    Dim rg As Range
    
    With ActiveSheet ' improve!
        If .FilterMode Then .ShowAllData ' clear filters
        If .AutoFilterMode Then .AutoFilterMode = False ' turn off auto filter
        Set rg = .Range("A1").CurrentRegion
    End With
    
    ' Write the values from the critical column of the range to an array.
    
    Dim rCount As Long: rCount = rg.Rows.Count - 1
    Dim Data():
    Data = rg.Columns(F_COLUMN).Resize(rCount).Offset(1).Value
        
    ' Write the matching strings to the keys (a 1D array) of a dictionary.
    
    ' Define the dictionary.
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    ' Declare variables to be introduced in the For...Next loop.
    Dim SubStrings() As String, r As Long, rStr As String
    
    ' Loop through the elements of the array.
    For r = 1 To rCount
        ' Convert the current value to a string and store it in a variable.
        rStr = Data(r, 1)
        If Len(rStr) > 0 Then ' is not blank
            ' Split the string into an array.
            SubStrings = Split(rStr, F_DELIMITER)
            ' Attempt to match the criterion in the split array.
            If IsNumeric(Application.Match(F_CRITERION, SubStrings, 0)) Then
                If Not dict.Exists(rStr) Then ' not in the dictionary
                    dict(rStr) = Empty
                'Else ' already in the dictionary; do nothing
                End If
            'Else ' criterion not found, it's an error value; do nothing
            End If
        'Else ' is blank; do nothing
        End If
    Next r
    
    ' Filter the table range.
    
    If dict.Count > 0 Then ' there are rows to be filtered
        ' Use the keys (a 1D array) of the dictionary
        ' with 'xlFilterValues' to filter the data.
        rg.AutoFilter F_COLUMN, dict.Keys, xlFilterValues
    'Else ' no rows to be filtered; do nothing
    End If
    
End Sub