ListBoxを操作するクラスモジュール ⑩ まとめ

ListBoxを操作するクラスモジュールを、私なりに作成してきた。
前回は、レーベンシュタイン距離を用いて、「探している文字と何か似てる」ものを探すことに挑戦した。
infoment.hatenablog.com

今日も、前回の続きから。

前回の更新から色々と調整して、一通りの目途がついた。
ということで今日は、今までのまとめとする。

クラスモジュール（ListBoxControl）

今まで細切れに載せてきたクラスモジュールだが、今日は全文を載せる。

↓ こちらをクリックして展開表示。

◆ソースコード（クリックで展開）◆

Option Explicit

' 対象となるリストボックス。
Public TargetListBox As MSForms.ListBox

' リストとして与えられた配列（二次元配列）。
' 一次元配列は、複数行１列の二次元配列に変換後のもの。
' またインデックスは、行と列ともに０始まりへ矯正後のもの。
Private SourceListArray() As Variant

' 最新のリスト内容を反映した二次元配列。
' 値の取得や絞り込みなどは常に、まず配列を作成したうえで
' リストボックスに結果を返すものとする。
Public LatestListArray As Variant

' ループ用整数。
Private i As Long
Private j As Long

Private Sh(1) As Worksheet

' リスト用に与えられた配列の次元数。
Private DimensionNumber As Long

Private Sub Class_Initialize()

    ' リストボックスに渡した配列の次元数。
    ' 初期値は一次元配列とする。
    DimensionNumber = 1

End Sub

' リストボックスにリストをセット。
Public Sub InitializeList(ByVal source_list_array As Variant, _
                 Optional column_number_autofit As Boolean = False, _
                 Optional column_width_autofit As Boolean = False)

    ' 仮の配列。
    Dim temp As Variant
        ' list_arrayが配列なら、そのままTempにセット。
        ' 配列でないならば、一旦配列化したのちセット。
        If IsArray(source_list_array) Then
            temp = source_list_array
        Else
            temp = Array(source_list_array)
        End If
        TargetListBox.List = temp
    
        ' 配列のインデックスについて、最小値を一旦
        ' 「1」としたい。
        ' 配列が一次元の場合、Transpose関数で一旦行列を反転させると、
        ' インデックスの最小値が１の、複数行１列の二次元配列になる。
        temp = WorksheetFunction.Transpose(temp)
        
        ' 二次元目のインデックス最大値が１で無い場合、配列は元から
        ' 二次元配列ということになる。したがって、行列を反転して元に戻す。
        ' またこの時点で、元の配列のインデックス最小値が何であっても、
        ' 行と列ともに１から始まる配列となる。
        If UBound(temp, 2) <> 1 Then
            temp = WorksheetFunction.Transpose(temp)
            DimensionNumber = 2
        End If
        
        ' リストボックスのリストと同じ構成の二次元配列を作成する。
        ' リストボックスは行列共に０始まりであるため、下記でその
        ' ギャップを解消している。
    ReDim SourceListArray(UBound(temp) - 1, UBound(temp, 2) - 1)
        For i = 0 To UBound(SourceListArray)
            For j = 0 To UBound(SourceListArray, 2)
                SourceListArray(i, j) = temp(i + 1, j + 1)
            Next
        Next
        
        ' 初回であるため、最新のリストを元のリストとする。
        LatestListArray = SourceListArray

        ' 列数調整。
        If column_number_autofit Then
            TargetListBox.ColumnCount = UBound(LatestListArray, 2) + 1
        End If

        ' 列幅調整。
        If column_width_autofit Then
            TargetListBox.ColumnWidths = ColumnWidthValue
        End If

End Sub

' リストボックスのリストを更新。
Public Sub UpdateList(ByVal list_array As Variant)

    ' 仮の配列。
    Dim temp As Variant
        ' list_arrayが配列なら、そのままTempにセット。
        ' 配列でないならば、一旦配列化したのちセット。
        If IsArray(list_array) Then
            temp = list_array
        Else
            temp = Array(list_array)
        End If
        TargetListBox.List = temp
        LatestListArray = temp

End Sub

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

' 選ばれた行のインデックスが格納された配列。
Public Property Get SelectedIndex() As Variant
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
        For i = 0 To TargetListBox.ListCount - 1
            If TargetListBox.Selected(i) Then
                Dict(i) = True
            End If
        Next
        
        SelectedIndex = Dict.keys
End Property

' リストボックスの選択行数。
Public Function SelectedCount() As Long
    SelectedCount = UBound(SelectedIndex) + 1
End Function

' リスト内で選択された行の値を配列で取得する。
Public Function SelectedValues() As Variant
    
    ' データ格納用配列。
    Dim arr() As Variant
        
        ' 選択行数が０ならば、空配列を返す。
        If SelectedCount = 0 Then
            arr = Array()
        Else
            
            ' 選択行数が１以上の場合、リストの元となった配列の次元数で
            ' 戻り値となる配列の次元数を変える。
            Dim Counter As Long: Counter = 0
            Select Case DimensionNumber
            
                ' リスト用配列が一次元配列の場合、各行の値は一つしかないため、
                ' 一次元配列に格納する。
                Case 1
                    ReDim arr(SelectedCount - 1)
                        For i = 0 To TargetListBox.ListCount - 1
                            If TargetListBox.Selected(i) Then
                                arr(Counter) = TargetListBox.List(i)
                            End If
                        Next
                ' 二次元配列の場合。
                Case 2
                    ReDim arr(SelectedCount - 1, UBound(LatestListArray, 2))
                        For i = 0 To TargetListBox.ListCount - 1
                            If TargetListBox.Selected(i) Then
                                For j = 0 To UBound(arr, 2)
                                    arr(Counter, j) = TargetListBox.List(i, j)
                                Next
                                Counter = Counter + 1
                            End If
                        Next
            End Select
        End If
        
        SelectedValues = arr
End Function

' リストボックス内の全行を選択。
Public Sub SelectAll()
    For i = 0 To TargetListBox.ListCount - 1
        TargetListBox.Selected(i) = True
    Next
End Sub

' リストボックス内の全行を非選択。
Public Sub UnselectAll()
    For i = 0 To TargetListBox.ListCount - 1
        TargetListBox.Selected(i) = False
    Next
End Sub

' リストボックス内の全行について、選択状態を反転。
Public Sub ReverseSelection()
    For i = 0 To TargetListBox.ListCount - 1
        TargetListBox.Selected(i) = Not TargetListBox.Selected(i)
    Next
End Sub

' リストボックス内にある検索値が含まれる行について、
' そのインデックスを配列で返す。
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(LatestListArray, 2)
                
                ' 列数指定が－１、つまり未指定であるならば、リストボックス全体を
                ' 検索対象とする。
                If target_column = -1 Or target_column = j Then
                    For i = 0 To UBound(LatestListArray)
                        temp = LatestListArray(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
        
        ' 戻り値としての配列を昇順ソート。
        FindAll = SortArray(FindAll)
        
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

' リストボックス内にある検索値が含まれる行のみで
' リストボックスを更新する。
Public Sub FindAndUpdateList(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)
    
    ' 検索値を含む行のインデックスを配列で受け取る。
    Dim arr As Variant
        arr = FindAll(faWhat, target_column, faLookAt, faMatchCase, faMatchByte)

        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 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
        
        On Error GoTo er:
        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」としている（実際は、何でもよい）。
                    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


' 一次元配列のソート。
Private Function SortArray(arr As Variant, _
                Optional sort_order As Excel.XlSortOrder = xlAscending) As Variant
    Dim aryList As Object
    Dim s As Variant
    Set aryList = CreateObject("System.Collections.ArrayList")
    
    Dim LoopIndex As Variant
        For Each LoopIndex In arr
            Call aryList.Add(LoopIndex)
        Next
        
        Select Case sort_order
            Case xlAscending
                ' 昇順でソート。
                Call aryList.Sort
            Case xlDescending
                ' 昇順でソートののち、降順へ反転。
                Call aryList.Sort
                Call aryList.Reverse
        End Select
        
        SortArray = aryList.ToArray
End Function

' 列幅自動調整用。
' メイリオで最適化している。
' フォントサイズ×最大文字バイト数÷２を、幅のポイント数とする。
Public Property Get ColumnWidthArray() As Variant
    Dim arr() As Variant
    ReDim arr(UBound(LatestListArray, 2))
    Dim temp As Double
        For j = 0 To UBound(LatestListArray, 2)
            For i = 0 To UBound(LatestListArray)
                temp = LenB(StrConv(LatestListArray(i, j), vbFromUnicode)) * TargetListBox.Font.Size * 0.7
                If arr(j) < temp Then
                    arr(j) = temp
                End If
            Next
        Next
        
        ColumnWidthArray = arr
End Property

Public Property Get ColumnWidthValue() As String
    ColumnWidthValue = Join(ColumnWidthArray, ";")
End Property

' 参照元。
' URL ⇒　https://code.i-harness.com/ja-jp/q/40be5c
Public Function Levenshtein(ByVal string1 As String, ByVal string2 As String) As Long

    Dim i As Long
    Dim j As Long
    Dim string1_length As Long
        string1_length = Len(string1)
    Dim string2_length As Long
        string2_length = Len(string2)
    Dim distance() As Long
    ReDim distance(string1_length, string2_length)
    
        For i = 0 To string1_length
            distance(i, 0) = i
        Next
        
        For j = 0 To string2_length
            distance(0, j) = j
        Next
    
        For i = 1 To string1_length
            For j = 1 To string2_length
                If Asc(Mid$(string1, i, 1)) = Asc(Mid$(string2, j, 1)) Then
                    distance(i, j) = distance(i - 1, j - 1)
                Else
                    distance(i, j) = Application.WorksheetFunction.Min _
                    (distance(i - 1, j) + 1, _
                     distance(i, j - 1) + 1, _
                     distance(i - 1, j - 1) + 1)
                End If
            Next
        Next
    
        Levenshtein = distance(string1_length, string2_length)

End Function

' 一致率。
Public Function MatchRatio(ByVal string1 As String, ByVal string2 As String) As Double

    Dim ⊿ As Long
        ⊿ = Levenshtein(string1, string2)
        
        MatchRatio = (Len(string1) - ⊿) / Len(string1)

End Function

' 一致率を収めた配列。
Public Function MatchRatioAll(mrWhat As Variant, _
                     Optional target_column As Long = -1) As Variant
    Dim arr() As Variant
    ReDim arr(1 To (UBound(LatestListArray) + 1) * (UBound(LatestListArray, 2) + 1) + 1, _
              1 To 5)
              
        arr(1, 1) = "行番号"
        arr(1, 2) = "列番号"
        arr(1, 3) = "指定文字"
        arr(1, 4) = "比較文字"
        arr(1, 5) = "一致率％"

    Dim temp As String
    Dim Counter As Long: Counter = 2

        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)
                    arr(Counter, 1) = i
                    arr(Counter, 2) = j
                    arr(Counter, 3) = mrWhat
                    arr(Counter, 4) = temp
                    arr(Counter, 5) = Format(MatchRatio(CStr(mrWhat), temp) * 100, "0.0")
                    Counter = Counter + 1
                Next
            End If
        Next
    
        MatchRatioAll = Sort2DArray(arr, xlYes, 5, xlDescending)
              
End Function

' 二次元配列のソート。
Public Function Sort2DArray(source_array As Variant, _
                   Optional header As XlYesNoGuess = xlYes, _
                   Optional target_column_index As Variant = 1, _
                   Optional sort_order As Excel.XlSortOrder = xlAscending) As Variant
                   
    On Error GoTo er:
                   
    Application.ScreenUpdating = False

    ' 現在の表示シートをセット（後ほど選択するため）。
    Set Sh(0) = ActiveSheet
    
    ' 並び替え用シートの有無確認。なければ追加ののち、
    ' もともと表示していたシートを選択しなおす。
    ' ※ソートしなおすたびに一瞬画面が切り替わるため、
    ' 　ソート用シートは表示しないようにしておく。
        If Sh(1) Is Nothing Then
            Set Sh(1) = Sheets.Add
            Sh(0).Activate
        End If
    
    ' ひとつ前のソート結果が残っている場合があるので、いったんクリアする。
        Sh(1).Cells.Clear
    
    ' 並び替えたい配列を張り付ける。
        Sh(1).Range("A1").Resize(UBound(source_array), UBound(source_array, 2)) = source_array

    ' ラベル名での並び替えを可能とするために、張り付けた配列をテーブル化する。
    Dim Tb As ListObject
    Set Tb = Sh(1).ListObjects.Add(xlSrcRange, Sh(1).UsedRange, , header)
    
    ' ソート列番号取得。
    ' target_column_indexが数値ならば、そのままソート列番号とする。
    ' target_column_indexがそれ以外ならば、テーブルのラベル名とみなし、
    ' 相当する列番号をソート列番号とする。
    ' ColumnIndexが0ならば、それはエラーを無視しさせた結果であり、指定した
    ' ラベル名がテーブルに存在しないことを意味する。この場合、ソート列を１
    ' とする。
    Dim ColumnIndex As Long
        Select Case IsNumeric(target_column_index)
            Case True
                ColumnIndex = target_column_index
            Case Else
                On Error Resume Next
                ColumnIndex = Tb.ListColumns(target_column_index).Index
                If ColumnIndex = 0 Then ColumnIndex = 1
                On Error GoTo 0
        End Select
    
    ' ソート列番号がテーブル列サイズより大きい場合、列番号の指定が空振り
    ' しているため、強制的に１列目をソート列とする。
        If Tb.ListColumns.Count > ColumnIndex Then
            ColumnIndex = 1
        End If
    
    ' ソート。
        Tb.Sort.SortFields.Clear
        Tb.Sort.SortFields.Add Key:=Cells(1, ColumnIndex), _
                               Order:=sort_order

        With Tb.Sort
            .header = header
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    
    ' シート上のソート結果を戻り値とする。
        Sort2DArray = Tb.Range
    
    Application.ScreenUpdating = True
    
    Exit Function
    
er:
    Sort2DArray = Array()
    Application.ScreenUpdating = True
    
        
End Function

Private Sub Class_Terminate()
    ' DisplayAlertsの現在の設定を退避。
    Dim DisplayAlertsState As Boolean
        DisplayAlertsState = Application.DisplayAlerts
    
    ' ソートした、つまりソートに用いたSh(1)が存在するならば、
    ' それを削除する。削除後は、DisplayAlertsの設定を元に戻す。
        If Not Sh(1) Is Nothing Then
            Application.DisplayAlerts = False
            Sh(1).Delete
            Application.DisplayAlerts = DisplayAlertsState
        End If
End Sub

ユーザーフォーム

今回はまとめということで、今まで紹介した機能のいくつかを盛り込んだ。

それぞれの機能を、それなりに簡略化できたと思う。

Option Explicit

Dim Lbc(1 To 2) As VBAProject.ListBoxControl
Dim Tb As ListObject

' ユーザーフォームの初期化。
Private Sub UserForm_Initialize()
    
    Set Tb = ActiveSheet.ListObjects(1)

    ' リストボックスに表示する範囲を、一旦配列に格納。
    Dim arr As Variant
        arr = Tb.Range
    
    ' クラスモジュールの初期化。
    Dim i As Long
        For i = 1 To 2
            Set Lbc(i) = New VBAProject.ListBoxControl
            Set Lbc(i).TargetListBox = Me.Controls("ListBox" & i)
        Next
        
        ' リストの内容として配列をセット。
        Lbc(1).InitializeList arr, True, True
End Sub

' 全選択ボタン。
' ※ボタンを押すたび、全解除と切り替わる。
Private Sub AllSelectButton_Click()
    Select Case AllSelectButton.Caption
        Case "全選択"
            Lbc(1).SelectAll
            AllSelectButton.Caption = "全解除"
        Case "全解除"
            Lbc(1).UnselectAll
            AllSelectButton.Caption = "全選択"
    End Select
End Sub

' Ｏ型だけ全て選ぶボタン。
Private Sub OTypeSelectButton_Click()
    Lbc(1).FindAndSelectAll "O型", Tb.ListColumns("血液型").Index - 1
End Sub

' 選択中のものを非選択に、非選択中のものを選択するボタン。
Private Sub ReverseButton_Click()
    Lbc(1).ReverseSelection
End Sub

' 鳥取県民だけのリストにするボタン。
Private Sub TottoriButton_Click()
    Lbc(1).FindAndUpdateList "鳥取県", Tb.ListColumns("都道府県").Index - 1
End Sub

' リセットボタン。
Private Sub ResetButton_Click()
    Lbc(1).ResetList
    Lbc(2).TargetListBox.Clear
    
    TextBox1.Value = vbNullString
    TextBox2.Value = vbNullString
End Sub

' 正規表現を利用した絞り込み。
Private Sub TextBox1_Change()
    Lbc(1).ResetList
    If TextBox1.Value <> vbNullString Then
        Lbc(1).RegExpAndUpdateList TextBox1.Value
    End If
End Sub

' 名前の一致率表示。
Private Sub TextBox2_Change()
    Dim arr As Variant
        If TextBox2.Value <> vbNullString Then
            arr = Lbc(1).MatchRatioAll(TextBox2.Value, 1)
            Lbc(2).InitializeList arr, True, True
        Else
            Lbc(2).TargetListBox.Clear
        End If
End Sub

' 選択項目を元のリストボックスでも選択。
Private Sub ListBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim SelectedIndex As Long
        If Lbc(2).SelectedCount <> 1 Then
            SelectedIndex = 1
        Else
            SelectedIndex = Lbc(2).SelectedValues(0, 0)
        End If
        
        Lbc(1).UnselectAll
        Lbc(1).TargetListBox.Selected(SelectedIndex) = True
        Lbc(1).TargetListBox.ListIndex = SelectedIndex
End Sub

確認結果

各ボタンなどの動作を確認した結果がこちら。

一応、想定したとおりに動いてくれた。
ということで、今回のシリーズはここまで。

今後、何か機能拡張したら、都度こちらに追記することにします。

参考まで。