ListBox内で値の検索②

おさらい

前回まででListBox内の値をセルに吐き出したり、エラートラップを仕掛けたりしましたね。

何度も言いますが、ListBoxの中身を追加する為には「AddItem」メソッドを使用してきました。

また、CommandButtonに処理を登録してListBox内のアイテムが選択されていたらD2のセルに値を入力するところまで出来上がりましたね。

それでは実際に検索機能をつけていきましょう。

イベント登録

イベント登録というとちょっと難しく感じるかも知れません。具体的に何をするのかというと検索ワード入力スペースとして作ったTextBoxの値が変わったらプログラムが実行される仕組みを作ろうかという事です。

イベントの登録方法は至って簡単です。

検索ワード入力スペースとして作成したTextBox1をダブルクリックしてみてください。

そうすると↓

Private Sub TextBox1_Change()

End Sub

と出てきましたね。

この中にプログラムを記述すればTextBox1の値がChangeしたら(変わったら)プログラムを走らせることができます。

練習プログラムを書いてみましょう

では実際にどうなるのかという事を試す為にTextBox1の値が書き変わる度にTextBox1の値をMsgBoxで出力するようにしてみましょう。

Private Sub TextBox1_Change()
    MsgBox Me.TextBox1.Value

End Sub

たったのこれだけです。

これだけでTextBox1の値が変わる度にMsgBoxでTextBox1の値を教えてくれます。

半角英数字入力の場合は即時、日本語入力の時はEnterで確定した時に処理が走りますね。

ListBoxのItemを取得

ではここまでやったものを使用して実際に検索機能を実現する為にまずはListBoxのItemを取得してみましょう。

という事で配列に一旦格納しましょう。

ここで覚えておいて頂きたいのがListBoxのアイテム数は「オブジェクト名.ListCount」で取得出来るという事です。今回はListBoxの名前はListBox1なので「ListBox1.ListCount」でアイテム数が取れます。そしてListBox内のItemは「オブジェクト名.List(Itemのインデックス数)」で取得出来ます。

今回は都道府県なのでもちろん47が返ってきます。ただし、ListBox内のItemを取得する場合は0から始まるので注意しましょう。

という事で今回はDo Loopで配列に格納していきましょう。

Private Sub TextBox1_Change()

    Dim arr() As String
    Dim i     As Long
    
    ReDim arr(0)
    i = 0
    Do
        arr(UBound(arr)) = Me.ListBox1.List(i)
        i = i + 1
        If i = Me.ListBox1.ListCount Then Exit Do
        ReDim Preserve arr(UBound(arr) + 1)
    Loop

End Sub

この様にすれば右側のローカルウィンドウに表示されているようにListBox内のItem一覧を取得する事が出来ます。

後は検索ワードの文言が含まれていればその文言を一番上に来るように並び替えればOKですね。僕の場合は検索ワードが間違っていた場合も選び直す事が出来るようにヒットしたものだけを表示するのではなくヒットしたものを上にもってきてヒットしなかったものをその下に表示させるようにしています。

ワイルドカード

Excelの文字列検索等に使用するワイルドカードってご存知でしょうか?

*(アスタリスク)を付けると曖昧な検索が出来る機能ですね。

例えば『山』という文字が入った都道府県を抜き出したいとした場合は

*山*

これは前後に何かしらが入っていて(入っていなくても可)尚且つ山という文字が含まれているもの。という意味です。

これで山という文字が入った都道府県を抽出する事が出来ます。この機能を使って検索機能を実現しようかと思います。

今回は簡単に「ヒットした場合の文字列」と「ヒットしなかった場合の文字列」を用意して配列に変換後、文字列の区切りは,(カンマ)で統一します。

そして最後にListBoxにAddItemする仕様で作っていきましょう。

検索部分の記述

Private Sub TextBox1_Change()

    Dim arr()  As String  ' ListBoxの全Item
    Dim sHit   As String  ' ヒットした場合の文字列
    Dim sNot   As String  ' ヒットしなかった場合の文字列
    Dim search As String  ' 検索ワード
    Dim all    As Variant ' 最終的にまとめる配列
    Dim i      As Long
    
    ReDim arr(0)
    i = 0
    Do
        arr(UBound(arr)) = Me.ListBox1.List(i)
        i = i + 1
        If i = Me.ListBox1.ListCount Then Exit Do
        ReDim Preserve arr(UBound(arr) + 1)
    Loop
    
    ' まずはListBox内のItemを削除
    Me.ListBox1.Clear
    ' 配列arrからヒット・ノーヒットに切り分ける
    search = Me.TextBox1.Value
    
    For i = LBound(arr) To UBound(arr)
        If arr(i) Like "*" & search & "*" Then
            sHit = sHit & arr(i) & ","
        Else
            sNot = sNot & arr(i) & ","
        End If
    Next
    
    ' ヒット・ノーヒットを一つの文字列に変換
    all = sHit & sNot
    ' デリミッタ,(カンマ)で配列に変換
    all = Split(all, ",")
    
    ' 要素が空じゃなければListBoxにAddItem
    For i = LBound(all) To UBound(all)
        If Not all(i) Like "" Then
            Me.ListBox1.AddItem all(i)
        End If
    Next
    
End Sub

完成

後はご自身で動かしてみて下さい。

あくまでもメモリ空間上で行っている処理なのでもったりすることもなく快適に検索が出来ると思います。

今回は少し長かったので全文を下に載せますのでご参考までに。

Option Explicit

Private Sub CommandButton1_Click()

    Dim inputRng As Range
    
    Set inputRng = Range("d2")
    
    If Me.ListBox1.Value Like "" Then
        MsgBox "リストから選択してください"
        Exit Sub
    End If
    
    inputRng.Value = Me.ListBox1.Value
    
    Unload Me

End Sub

Private Sub CommandButton2_Click()

    Unload Me

End Sub

Private Sub TextBox1_Change()

    Dim arr()  As String  ' ListBoxの全Item
    Dim sHit   As String  ' ヒットした場合の文字列
    Dim sNot   As String  ' ヒットしなかった場合の文字列
    Dim search As String  ' 検索ワード
    Dim all    As Variant ' 最終的にまとめる配列
    Dim i      As Long
    
    ReDim arr(0)
    i = 0
    Do
        arr(UBound(arr)) = Me.ListBox1.List(i)
        i = i + 1
        If i = Me.ListBox1.ListCount Then Exit Do
        ReDim Preserve arr(UBound(arr) + 1)
    Loop
    
    ' まずはListBox内のItemを削除
    Me.ListBox1.Clear
    ' 配列arrからヒット・ノーヒットに切り分ける
    search = Me.TextBox1.Value
    
    For i = LBound(arr) To UBound(arr)
        If arr(i) Like "*" & search & "*" Then
            sHit = sHit & arr(i) & ","
        Else
            sNot = sNot & arr(i) & ","
        End If
    Next
    
    ' ヒット・ノーヒットを一つの文字列に変換
    all = sHit & sNot
    ' デリミッタ,(カンマ)で配列に変換
    all = Split(all, ",")
    
    ' 要素が空じゃなければListBoxにAddItem
    For i = LBound(all) To UBound(all)
        If Not all(i) Like "" Then
            Me.ListBox1.AddItem all(i)
        End If
    Next
    
End Sub

Private Sub UserForm_Initialize()

    Dim i As Long
    
    For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
        Me.ListBox1.AddItem Cells(i, 2).Value
    Next

End Sub

では、次回はまた何かテーマを見つけて更新したいと思います。

<<ListBox内で値の検索
スポンサーリンク

シェアする

フォローする