ListBoxを操作するクラスモジュール ③ 検索文字を含む行を全て選択

ListBoxを操作するクラスモジュールを、私なりに作成中。
昨日は、全選択・全解除・選択反転を行ってみた。
infoment.hatenablog.com

今日も、昨日の続きから。

今日は、指定した文字を含む行を全て選択することに挑戦。
そのための作戦は、以下のとおり。

1. リストボックス内にある、検索値が含まれるすべての行について、
   そのインデックスを配列で返す。
2. 同配列を用いて、リストボックス内の行を全て選択する。

なぜ二段構えにしたかというと、上記１だけで何かと使えそうだから。
（見切り発車）。

クラスモジュール（ListBoxControl）

' リストボックス内にある検索値が含まれる行について、
' そのインデックスを配列で返す。
Public Function FindAll(faWhat As Variant, _
               Optional target_column As Long = -1, _
               Optional faLookAt As Excel.XlLookAt = xlPart, _
               Optional faMatchCase As Boolean = False, _
               Optional faMatchByte As Boolean = False) As Variant
     
    ' インデックス格納用辞書。
    ' 後ほどキー情報をまとめて配列として渡せること、要素数に応じた
    ' 拡張が自動で行われることを理由に、辞書を用いている。
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    
    ' 検索値は単一であっても、配列で複数渡されても対応可能とする。
    Dim WhatArray As Variant
        If IsArray(faWhat) Then
            WhatArray = faWhat
        Else
            WhatArray = Array(faWhat)
        End If
        
    Dim LoopIndex As Variant
    Dim Temp As String
    
        ' 各検索値に対し、繰り返し処理を行う。
        For Each LoopIndex In WhatArray
        
            ' 大文字・小文字不問であるならば、検索値を全て大文字にしておく。
            If Not faMatchCase Then
                LoopIndex = StrConv(LoopIndex, vbUpperCase)
            End If
            
            ' 半角・全角不問であるならば、検索値を全て全角にしておく。
            If Not faMatchByte Then
                LoopIndex = StrConv(LoopIndex, vbWide)
            End If
            
            ' 部分一致であるならば、検索値の前後にワイルドカードを付しておく。
            If faLookAt = xlPart Then
                LoopIndex = "*" & LoopIndex & "*"
            End If
        
            For j = 0 To UBound(ListArray, 2)
                
                ' 列数指定が－１、つまり未指定であるならば、リストボックス全体を
                ' 検索対象とする。
                If target_column = -1 Or target_column = j Then
                    For i = 0 To UBound(ListArray)
                        Temp = ListArray(i, j)
                        
                        ' 大文字・小文字に対する前処理。
                        If Not faMatchCase Then
                            Temp = StrConv(Temp, vbUpperCase)
                        End If
                        
                        ' 半角・全角に対する前処理。
                        If Not faMatchByte Then
                            Temp = StrConv(Temp, vbWide)
                        End If
                        
                        ' 部分一致対応のため、Like演算子で比較。
                        ' 辞書のItem情報は使用しないため不問。今回は一致したという
                        ' 意味を込めて「True」としている（実際は、何でもよい）。
                        If Temp Like LoopIndex Then
                            Dict(i) = True
                        End If
                    Next
                End If
            Next
        Next
        
        ' キー情報（つまりインデックス情報）を戻り値とする。
        FindAll = Dict.keys
End Function

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

End Sub

ユーザーフォーム

それでは、昨日のユーザーフォームに追加してみよう。
今回は、「りんご」と「ばなな」を含む行を、全て追加してみる。

Private Sub SelectButton_Click()
    Dim arr As Variant
        arr = Array("りんご", "ばなな")
        
        Lbc.FindAndSelectAll arr
End Sub

試してみた結果がコチラ。

少しずつ、充実してきた。

次回に続きます。

参考まで。