Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
697 views
in Technique[技术] by (71.8m points)

vba - Can AutoFilter take both inclusive and non-inclusive wildcards from Dictionary keys?

I have been looking for a way to filter an Excel spreadsheet with more than two wildcards. I asked on StackOverflow previously if I could put more than two wildcards in to AutoFilter in VBA directly instead of using advanced filter in the worksheet, as my macros are mostly used via PowerShell scripts, which pass input through. These wildcards are used to filter various spreadsheets and the result is saved.

A very helpful user came up with an answer gave an example macro using Dictionary keys, which I then extended to accept an array as input, and then loop through all the items in the array to filter as wildcards. Excellent, working as intended!

Now I want to extend this to pass more specific wildcards I want to exclude. Say for example, I want to include "A*" and "B*", but not "BB*", so that "BA*" would still be there, for example. Could the below macro work with maybe passing <>BB* through?

The hierArray only ever contains a list of simple strings consisting of a maximum 10 (but rarely more than 3 characters).

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
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

I'm going to stick to the ! prefix for the discards as that is a single character.

    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

When creating the hierArray string, you can save a few cycles by putting the discard patterns first. That way, they will not get added and then subsequently removed.

Any further work in this areas would likely warrant switching to a full Regular Expression () pattern matching method.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...