おさらい
前回まででListBox内の値をセルに吐き出したり、エラートラップを仕掛けたりしましたね。
何度も言いますが、ListBoxの中身を追加する為には「AddItem」メソッドを使用してきました。
また、CommandButtonに処理を登録してListBox内のアイテムが選択されていたらD2のセルに値を入力するところまで出来上がりましたね。
それでは実際に検索機能をつけていきましょう。
イベント登録
イベント登録というとちょっと難しく感じるかも知れません。具体的に何をするのかというと検索ワード入力スペースとして作ったTextBoxの値が変わったらプログラムが実行される仕組みを作ろうかという事です。
イベントの登録方法は至って簡単です。
検索ワード入力スペースとして作成したTextBox１をダブルクリックしてみてください。
そうすると↓
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
では、次回はまた何かテーマを見つけて更新したいと思います。