VBA：リストボックスの絞り込み検索（インクリメンタルサーチ）

VBAでリストボックスの絞り込み検索機能（インクリメンタルサーチ）を作ってみたら、いいかんじのができたのでご紹介します。

検索したい単語の一部を入力すると、部分一致する候補がリストボックスに表示されます。Googleの検索窓のあれです。つくりは素朴ですが、少なくとも数千件程度なら快適に動作します。

データの準備

検索対象リストの値をシート Sheet1 に用意しておきます。サンプルは東証上場銘柄リストです。

配列としてデータを取得できればいいので、Array("1301 極洋","1331 日本水産", ... ) のように直書きするなど他の方法でもいいです。VBAではセル範囲を代入して取得した配列は、たとえセル範囲が1列でも2次元配列になりますが、今回は検索対象リストの配列が1次元でも2次元でも動くように For Each を使っています。

ユーザフォームの準備

ユーザフォームに、コンボボックス ComboBox1 を配置します。

ユーザフォームのコード

ユーザフォームのモジュールに、Initializeイベントと、コンボボックスのChangeイベントを追加します。
Index = -1、すなわち、コンボボックスの値が候補リストの中から選択されていない場合だけ、候補リストを更新するのがポイントです。これをしないと無限ループになります。

UserForm1.bas

'初期化
Private Sub UserForm_Initialize()
    ComboBox1.List = GetCandidates()                    'リストを設定(全項目)
End Sub

'値変更
Private Sub ComboBox1_Change()    
    'コンボボックスの値がリストにない場合はリストを更新
    If ComboBox1.ListIndex = -1 Then
        ComboBox1.Clear                                 'リストをクリア
        ComboBox1.List = GetCandidates(ComboBox1.Text)  'リストを設定(絞り込み)
        SendKeys "%{DOWN}"                              'リストを開く
    End If
End Sub

2022年3月現在、VBAの SendKeys には NumLock が効かなくなる不具合があるようです。回避策としては、WSHのSendKeysを使う方法があります。

候補リストを返す関数

標準モジュールに、候補リストを配列で返す関数 GetCandidates() を作成します。
この関数は、引数がないときは全項目のリストを返し、引数があるときは引数の文字列と部分一致する値のリストを返します。

Module1.bas

'候補リストを返す関数
Function GetCandidates(Optional inputText As String) As Variant
    '全項目(ここでは[A2:A2180])の配列、返り値の配列
    Dim item, items, c                      
    items = Range(Sheet1.Cells(2, 1), Sheet1.Cells(2180, 1)) 
    c = Array()
    '全項目を検索し、部分一致したら、返り値の配列の末尾に追加
    For Each item In items
        If item Like ("*" & inputText & "*") Then  
            Call Array_Push(c, item)
        End If
    Next
    GetCandidates = c
End Function

'配列の末尾に要素を追加
Function Array_Push(arr, item)
    ReDim Preserve arr(UBound(arr) + 1)        
    arr(UBound(arr)) = item
End Function

これでいったん完成です。
「配列の末尾に要素を追加」はVBAの泣き所、読みづらいので関数化しておきました。ひとつひとつ配列に追加するかわりに、各要素を Collection に追加しておいて、最後に Array に変換する方法もあります。

あいまい検索

ここまでの状態では、ひらがな/カタカナ、半角/全角などは、完全一致している必要があります。あいまい検索にしたいときは、たとえば下のようにします。

Module1_arranged_1.bas

        '部分一致(あいまい検索)
        If String_Normalize(CStr(item)) Like _
            "*" & String_Normalize(inputText) & "*" Then
            '配列の末尾に要素を追加
            '...
        End If

Module1_arranged_2.bas

'文字列比較の前処理(あいまい検索用)
Function String_Normalize(str As String) As String
    Dim ret As String
    ret = str
    ret = UCase(ret)                    '英字は大文字にする
    ret = StrConv(ret, vbWide)          '全角にする
    ret = StrConv(ret, vbHiragana)      'カタカナはひらがなにする
    ret = Replace(ret, "　", "")        'スペースは除去する
    String_Normalize = ret
End Function

その他、たとえば、ふりがなでも検索したい場合は、検索対象リストの横にふりがなリストも持って、両方を結合した文字列に対して部分一致の判定をする、といった工夫で対応できます。