AutoFilter可以从Dictionary键中获取包含通配符和非包含通配符吗?

时间:2016-01-05 14:45:40

标签: excel vba excel-vba dictionary autofilter

我一直在寻找一种过滤带有两个以上通配符的Excel电子表格的方法。之前我在StackOverflow上问过,如果我可以直接在VBA中将两个以上的通配符放入AutoFilter而不是在工作表中使用高级过滤器,因为我的宏主要通过PowerShell脚本使用,后者通过输入。这些通配符用于过滤各种电子表格,并保存结果。

一个非常有用的用户想出了一个回答,给出了一个使用Dictionary键的示例宏,然后我扩展为接受一个数组作为输入,然后循环遍历数组中的所有项以过滤为通配符。很棒,按预期工作!

现在我想扩展这个以通过我想要排除的更具体的通配符。例如,我想要包括“A *”和“B *”,但不包括“BB *”,以便“BA *”仍然存在。以下宏可以通过<> BB *通过吗?

hierArray只包含一个简单字符串列表,其中包含最多10个字符(但很少超过3个字符)。

Public Function multiHier(hierArray As Variant)

Dim v As Long, vVALs As Variant, dVALs As Object
Dim colNum As Long, hierLen As Integer, hier As Variant
Dim rng As Range

Set dVALs = CreateObject("Scripting.Dictionary")
dVALs.comparemode = vbTextCompare
colNum = Application.Match("*ierarchy*", Range("A1:Z1"), 0)

With Worksheets(1)
    'If .AutoFilterMode Then .AutoFilterMode = False

    With .Cells(1, 1).CurrentRegion
        vVALs = .Columns(colNum).Cells.Value2

        For v = LBound(vVALs, 1) To UBound(vVALs, 1)
            If Not dVALs.exists(vVALs(v, 1)) Then

                For Each hier In hierArray
                    hierLen = Len(hier)

                    Select Case UCase(Left(vVALs(v, 1), hierLen))
                        Case hier
                            dVALs.Add Key:=vVALs(v, 1), item:=vVALs(v, 1)
                        Case Else
                   End Select

               Next hier
            End If
        Next v

        If CBool(dVALs.Count) Then
            'populated the dictionary; now use the keys
            .AutoFilter Field:=colNum, Criteria1:=dVALs.keys, Operator:=xlFilterValues

            Set rng = Worksheets(1).AutoFilter.Range
            multiHier = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        Else
            multiHier = 0
        End If

    End With

End With

dVALs.RemoveAll: Set dVALs = Nothing

End Function

1 个答案:

答案 0 :(得分:4)

我会坚持使用丢弃的!前缀,因为这是一个字符。

    Dim h As Long, hstr As String   'put these at the top with the other var declarations

    For v = LBound(vVALs, 1) To UBound(vVALs, 1)
        For h = LBound(hierArray) To UBound(hierArray)   'I just prefer to work this way
            hstr = hierArray(h) & Chr(42)   'stick a * on the end
            If Left(hstr, 1) = Chr(33) And LCase(vVALs(v, 1)) Like LCase(Mid(hstr, 2)) Then     'starts with a ! and pattern matches the value
                'matched a discard pattern. check to see if it was previously added
                If dVALs.Exists(vVALs(v, 1)) Then _
                    dVALs.Remove vVALs(v, 1)    'get rid of it
                Exit For  'discarded. do not keep checking to add
            ElseIf LCase(vVALs(v, 1)) Like LCase(hstr) Then
                If NOT dVALs.Exists(vVALs(v, 1)) Then _
                    dVALs.Add Key:=vVALs(v, 1), Item:=vVALs(v, 1)
            End If
        Next h
    Next v

创建 hierArray 字符串时,首先放置丢弃模式可以节省几个周期。这样,它们就不会被添加,然后被删除。

此领域的任何进一步工作都可能需要切换到完整的正则表达式)模式匹配方法。