VBA 按字符串數組作為條件過濾

Question

我有一列需要過濾並檢查單元格是否包含列表中的任何單詞。

如果我有這樣的清單

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

我想過濾並查看包含任何這些單詞的任何單元格，我認為這樣的事情會做到：

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

在學習了很多之后，我想通了，這不適用於 arrays 但我確實可以使用字典鍵，所以我需要做的是構建一個包含我想要過濾掉的所有條目的字典。

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 的數組中

現在我 go 雖然數組中的每個值，我檢查，首先它是否已經在字典中，然后如果它不是現在我 go 我稱之為單詞的數組

我檢查它是否像該數組中的任何值，如果是，那么我將當前的 Columntofilter 值添加到字典中，作為鍵和項

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

現在我只需要使用字典鍵進行過濾

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

就是這樣啊，比預期的要長一點，但它有效

Answer 2

列中具有多個通配符條件的自動篩選

• 將完整代碼復制到標准模塊中，例如Module1
• 調整常量部分中的值。
• 僅運行第一個過程filterMultipleCriteria ，它正在調用 rest。

編碼

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