ListBoxを操作するクラスモジュール　⑦ 正規表現によるマッチング

ListBoxを操作するクラスモジュールを、私なりに作成中。
前回は、リストボックスの列数および列幅を自動調整することに挑戦した。
infoment.hatenablog.com

今日も、前回の続きから。
f:id:Infoment:20201008220250p:plain

前々回に、検索値を含む行だけでリストボックスを更新してみた。
こうなると、いつものように正規表現版も欲しくなる。

ということで、追加してみた。

クラスモジュール（ListBoxControl）

' リストボックス内にある値を正規表現で探し、マッチする値が
' 含まれる行について、そのインデックスを配列で返す。
Public Function RegExpAll(raPattern As Variant, _
                 Optional target_column As Long = -1, _
                 Optional raIgnoreCase As Boolean = False) As Variant
     
    ' インデックス格納用辞書。
    ' 後ほどキー情報をまとめて配列として渡せること、要素数に応じた
    ' 拡張が自動で行われることを理由に、辞書を用いている。
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    
    Dim myReg As Object
    Set myReg = CreateObject("VBScript.RegExp")
        ' 正規表現のパターン。
        myReg.Pattern = raPattern
        ' 大文字小文字の区別。
        myReg.IgnoreCase = raIgnoreCase
        
    Dim Temp As String
        
            For j = 0 To UBound(LatestListArray, 2)
                
            ' 列数指定が－１、つまり未指定であるならば、リストボックス全体を
            ' 検索対象とする。
            If target_column = -1 Or target_column = j Then
                For i = 0 To UBound(LatestListArray)
                    Temp = LatestListArray(i, j)
                    
                    ' 部分一致対応のため、Like演算子で比較。
                    ' 辞書のItem情報は使用しないため不問。今回は一致したという
                    ' 意味を込めて「True」としている（実際は、何でもよい）。
                    On Error GoTo er:
                    If myReg.Test(Temp) Then
                        Dict(i) = True
                    End If
                Next
            End If
        Next
        
        ' キー情報（つまりインデックス情報）を戻り値とする。
        RegExpAll = Dict.keys
        
        ' 戻り値としての配列を昇順ソート。
        RegExpAll = SortArray(RegExpAll)
        
        Exit Function
er:
        RegExpAll = Array()
End Function

' リストボックス内にある検索値が含まれる行について、
' その全てを選択する。
Public Sub RegExpAndSelectAll(raPattern As Variant, _
                     Optional target_column As Long = -1, _
                     Optional raIgnoreCase As Boolean = False)
    
    ' 検索値を含まない行が選択されたままとならないよう、全行の選択状態を
    ' 解除しておく。
    Call UnselectAll
    
    ' 検索値を含む行のインデックスを配列で受け取る。
    Dim arr As Variant
        arr = RegExpAll(raPattern, target_column, raIgnoreCase)
        
        TargetListBox.MultiSelect = fmMultiSelectMulti
    
    ' 受け取ったインデックスの行をすべて選択する。
    Dim LoopIndex As Variant
        For Each LoopIndex In arr
            TargetListBox.Selected(LoopIndex) = True
        Next

End Sub

' リストボックス内にある検索値が含まれる行のみで
' リストボックスを更新する。
Public Sub RegExpAndUpdateList(raPattern As Variant, _
                      Optional target_column As Long = -1, _
                      Optional raIgnoreCase As Boolean = False)
    
    ' 検索値を含む行のインデックスを配列で受け取る。
    Dim arr As Variant
        arr = RegExpAll(raPattern, target_column, raIgnoreCase)
        
        If UBound(arr) = -1 Then Exit Sub
        
    ' 検索値のみのリスト仮受け。
    Dim Temp() As Variant
    ReDim Temp(UBound(arr), UBound(SourceListArray, 2))
    Dim LoopIndex As Variant
        i = 0
        For Each LoopIndex In arr
            For j = 0 To UBound(Temp, 2)
                Temp(i, j) = LatestListArray(LoopIndex, j)
            Next
            i = i + 1
        Next
        
        LatestListArray = Temp
    Call UpdateList(LatestListArray)

End Sub

また、絞り込み結果を逐次リセットできるよう、以下も追加した。

Public Sub ResetList()
    ' 元の配列でリストを初期化する。
    UpdateList SourceListArray
End Sub

ユーザーフォーム

使い方としては、例えばこんな感じだ。前回の横長リストボックスの下に、
テキストボックスを配置する。
f:id:Infoment:20201008224233p:plain

このテキストボックスの値が変わるたびに、以下を実行してみる。

Private Sub TextBox1_Change()
    Lbc.ResetList
    If TextBox1.Value <> vbNullString Then
        Lbc.RegExpAndUpdateList TextBox1.Value
    End If
End Sub