VBA按字符串数组作为条件过滤

Question

我有一列需要过滤并检查单元格是否包含列表中的任何字词。

如果我有这样的清单

Targeted = Array("Word 1", "Word 2", "Word 3")

我想过滤并查看包含 any 这些词的 any 单元格，我认为这样的事情可以做到：

Dim Targeted As Variant
Targeted = Array("*Word 1*", "*Word 2*", "*Word 3*")

Dim Targeted_ColNum As Integer
Targeted_ColNum = Range("1:1").Find("Targeted", , xlValues, xlWhole).Column

Cells.AutoFilter Field:=Targeted_ColNum, Criteria1:=Targeted

但我似乎只过滤了最后一个单词，所以在这个例子中我只看到包含文本“Word 3”的单元格，而不是看到任何包含“Word 1”的单元格或 “Word 2” 或 “Word 3” 在其中

我做错了什么？

Answer 1

在学习了很多之后，我弄清楚了，这不适用于数组，但我确实可以使用字典键，所以我需要做的是构建一个包含我想要过滤掉的所有条目的字典。

Dim dicCriteria As Object
Dim ColumToFilter As Variant
Dim i As Long
    
Set dicCriteria = CreateObject("Scripting.Dictionary")
dicCriteria.CompareMode = 1 'vbTextCompare

'this is just how i find the specific range to filter out
With Range(Cells(2, LookFor_ColNum), Cells(lastrow, LookFor_ColNum))
    ColumToFilter = .Cells.Value
    For i = 1 To UBound(ColumToFilter, 1)
        If Not dicCriteria.Exists(ColumToFilter(i, 1)) Then
            Dim k As Integer
            For k = LBound(words) To UBound(words)
                Select Case True
                    Case ColumToFilter(i, 1) Like words(k)
                        dicCriteria.Add Key:=ColumToFilter(i, 1), Item:=ColumToFilter(i, 1)
                End Select
            Next k
        End If
    Next i

在这里我正在创建一个名为 dicCriteria 的空字典 然后我将要过滤的列的值放入一个名为 ColumntoFilter 的数组中

现在我检查数组中的每个值并检查，首先它是否已经在字典中，然后如果它现在没有，我会检查我称为单词的数组

我检查它是否像该数组中的任何值，如果是，那么我将当前 Columntofilter 值添加到字典中，作为键和项

最后，我得到了一个包含所有符合条件的条目的字典。

现在我只需要使用字典键进行过滤

If CBool(dicCriteria.Count) Then
        .AutoFilter Field:=LookFor_ColNum, Criteria1:=dicCriteria.keys, Operator:=xlFilterValues
End If

就是这样啊，比预期的要长一点，但它可以工作

Answer 2

在列中使用多个通配符条件的自动过滤

• 将完整代码复制到标准模块中，例如Module1
• 调整常量部分中的值。
• 只运行第一个过程filterMultipleCriteria，其余的都被它调用。

守则

Option Explicit

Sub filterMultipleCriteria()
    
    Const wsName As String = "Sheet1"
    Const HeaderRow As Long = 1
    Const HeaderCriteria As String = "Targeted"
    Const CriteriaStrings As String = "Word 1,Word 2,Word 3"
    Const CriteriaDelimiter As String = ","
    
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    Dim ws As Worksheet
    Set ws = wb.Worksheets(wsName)
    If ws Is Nothing Then Exit Sub
    Debug.Print ws.Name
    
    Dim cel As Range
    Set cel = findCellInRow(ws.Rows(HeaderRow), HeaderCriteria)
    If cel Is Nothing Then Exit Sub
    Debug.Print cel.Address
    
    Dim rng As Range
    Set rng = defineNonEmptyColumnRange(cel.Offset(1))
    If rng Is Nothing Then Exit Sub
    Debug.Print rng.Address
    
    Dim Data As Variant
    Data = getColumn(rng)
    If IsEmpty(Data) Then Exit Sub
    Debug.Print "[" & LBound(Data, 1) & "," & UBound(Data, 1) & "]"
    
    Dim wcFilter As Variant
    wcFilter = getWildcardFilters(Data, CriteriaStrings, CriteriaDelimiter)
    If IsEmpty(wcFilter) Then Exit Sub
    Debug.Print Join(wcFilter, vbLf)

    ws.Cells.AutoFilter Field:=cel.Column, Criteria1:=wcFilter, _
        Operator:=xlFilterValues

End Sub

Function findCellInRow(RowRange As Range, ByVal Criteria As Variant) As Range
    Dim cel As Range
    Set cel = RowRange.Find(What:=Criteria, _
        After:=RowRange.Cells(RowRange.Columns.Count), LookIn:=xlFormulas)
    If Not cel Is Nothing Then Set findCellInRow = cel
End Function

Function defineNonEmptyColumnRange(FirstCell As Range) As Range
    Dim cel As Range
    With FirstCell.Resize(FirstCell.Worksheet.Rows.Count - FirstCell.Row + 1)
        Set cel = .Find(What:="*", LookIn:=xlFormulas, _
            SearchDirection:=xlPrevious)
        If Not cel Is Nothing Then
            Set defineNonEmptyColumnRange = .Resize(cel.Row - .Row + 1)
        End If
    End With
End Function

Function getColumn(ColumnRange As Range) As Variant
    If ColumnRange.Columns(1).Rows.Count > 1 Then
        getColumn = ColumnRange.Value
    Else
        Dim Data As Variant: ReDim Data(1 To 1, 1 To 1)
        Data(1, 1) = ColumnRange.Value
        getColumn = Data
    End If
End Function

Function getWildcardFilters(ColumnData As Variant, CriteriaStrings As String, _
    Optional ByVal CriteriaDelimiter As String = ",") _
As Variant
    Dim Crit As Variant: Crit = Split(CriteriaStrings, CriteriaDelimiter)
    Dim cUpper As Long: cUpper = UBound(Crit)
    Dim Key As Variant, i As Long, n As Long
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 1 To UBound(ColumnData, 1)
            Key = ColumnData(i, 1)
            For n = 0 To cUpper
                If InStr(1, Key, Crit(n), vbTextCompare) > 0 Then
                    .Item(Key) = Empty
                    Exit For
                End If
            Next n
        Next i
        If .Count > 0 Then getWildcardFilters = .Keys
    End With
End Function