ListBoxを操作するクラスモジュール ⑤ 検索値を含む行のみでリストボックスを更新
ListBoxを操作するクラスモジュールを、私なりに作成中。
前回は、選択行の指定列の値を返すことに挑戦した。
infoment.hatenablog.com
今日も、前回の続きから。
ListBoxについて個人的に、今まで何度か需要があったのがこちら。
指定キーワードで、リストボックス内のリストを絞り込み
そこで、キーワードを含む行だけでリストボックスを更新することにした。
するとここで、今までの作りでは都合が悪いことに気づく。なぜなら、今の
作りでは常に、リストボックス作成時の配列を処理のメインに使用していた
ため、絞り込んだり元に戻したりに向いていないのだ。
そこで、初期の配列はそれとして保存し、現在のリストボックスを現わす
配列を別に設けたうえで、リストを更新する関数を新たに作成してみた。
というわけで今日は、クラスモジュールの全文を紹介する。リスト更新の
箇所については、その末尾を参照されたし。
クラスモジュール(ListBoxControl)
Option Explicit ' 対象となるリストボックス。 Public TargetListBox As MSForms.ListBox ' リストとして与えられた配列(二次元配列)。 ' 一次元配列は、複数行1列の二次元配列に変換後のもの。 ' またインデックスは、行と列ともに0始まりへ矯正後のもの。 Private SourceListArray() As Variant ' 最新のリスト内容を反映した二次元配列。 ' 値の取得や絞り込みなどは常に、まず配列を作成したうえで ' リストボックスに結果を返すものとする。 Public LatestListArray As Variant ' ループ用整数。 Private i As Long Private j As Long ' リスト用に与えられた配列の次元数。 Private DimensionNumber As Long Private Sub Class_Initialize() ' リストボックスに渡した配列の次元数。 ' 初期値は一次元配列とする。 DimensionNumber = 1 End Sub ' リストボックスにリストをセット。 Public Sub InitializeList(ByVal source_list_array As Variant) ' 仮の配列。 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関数で一旦行列を反転させると、 ' インデックスの最小値が1の、複数行1列の二次元配列になる。 Temp = WorksheetFunction.Transpose(Temp) ' 二次元目のインデックス最大値が1で無い場合、配列は元から ' 二次元配列ということになる。したがって、行列を反転して元に戻す。 ' またこの時点で、元の配列のインデックス最小値が何であっても、 ' 行と列ともに1から始まる配列となる。 If UBound(Temp, 2) <> 1 Then Temp = WorksheetFunction.Transpose(Temp) DimensionNumber = 2 End If ' リストボックスのリストと同じ構成の二次元配列を作成する。 ' リストボックスは行列共に0始まりであるため、下記でその ' ギャップを解消している。 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 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 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 ' 選択行数が0ならば、空配列を返す。 If SelectedCount = 0 Then arr = Array() Else ' 選択行数が1以上の場合、リストの元となった配列の次元数で ' 戻り値となる配列の次元数を変える。 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) ' 列数指定が-1、つまり未指定であるならば、リストボックス全体を ' 検索対象とする。 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) ' 検索値のみのリスト仮受け。 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
ユーザーフォーム
先日の「りんごとばなな」ボタンについて、りんごとばななを含む行のみで
リストボックスを更新してみた。
Private Sub SelectButton_Click() Dim arr As Variant arr = Array("りんご", "ばなな") Lbc.FindAndUpdateList arr End Sub
結果がこちら。
今のところ、動きは想定どおり。
次回に続きます。
参考まで。