ユーザーフォーム入門
インクリメンタルサーチの実装

Excelマクロのユーザーフォームの基礎、エクセルVBAの入門解説
公開日：2020-06-12　最終更新日：2020-06-12

第27回.インクリメンタルサーチの実装


VBA マクロ ユーザーフォーム インクリメンタルサーチ

VBAのユーザーフォームで大量のリストから選択する場合、
リストが大量にあると単なるコンボボックスやリストでは探すのが大変になってしまいます。


そこで、インクリメンタルサーチを実装してみます。

インクリメンタルサーチとは、
検索したい単語をすべて入力してから検索するのではなく、文字を入力するたびに即座に候補を表示させる機能です。
逐次検索と言われたりします。

テキストボックスに文字を入力すると、リストボックスが自動的に表れ、入力テキストと部分一致するリストだけを表示します。
↓キーでリストにフォーカスを移し、EnterまたはTabで選択が決定されます。


VBA マクロ ユーザーフォーム インクリメンタルサーチ

ユーザーフォームの作成

VBA マクロ ユーザーフォーム インクリメンタルサーチ

これはあくまでサンプルです。
以下のVBAコードで使用しているコントロールになります。
TextBox1
TextBox2
ListBox1
いずれも特に設定が必要なプロパティはありません。
テキストボックスはフォント等を適当に設定してください。
リストボックスは何も設定する必要がありません。

ユーザーフォームのVBAコード

Option Explicit

'イベント停止
Private StopEvent As Boolean
'リスト対象のTextBox
Private ActiveTextBox As Control
'ListBoxの1行：フォントサイズに合わせて適当に
Private Const BaseHeight As Single = 12

'フォーム初期処理
Private Sub UserForm_Initialize()
　　'リストボックスのスタイル等の設定
　　With Me.ListBox1
　　　　.Visible = False
　　　　.ListStyle = fmListStylePlain
　　　　.BorderStyle = fmBorderStyleSingle
　　　　.Font.Size = 11
　　　　.TabStop = False
　　End With
　　
　　StopEvent = False
End Sub

'TextBox1のイベント
Private Sub TextBox1_Change()
　　Call TextBoxChange(Me.TextBox1)
End Sub
Private Sub TextBox1_Enter()
　　Call TextBoxChange(Me.TextBox1)
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　　Call TextBoxKeyDown(Me.TextBox1, KeyCode, Shift)
End Sub

'TextBox2のイベント
Private Sub TextBox2_Change()
　　Call TextBoxChange(Me.TextBox2)
End Sub
Private Sub TextBox2_Enter()
　　Call TextBoxChange(Me.TextBox2)
End Sub
Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　　Call TextBoxKeyDown(Me.TextBox2, KeyCode, Shift)
End Sub

'リストボックスのEnterまたはTabでTextBoxにTextを入れる
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　　Select Case KeyCode
　　　　Case vbKeyReturn, vbKeyTab
　　　　　　'Enter,Tabでリスト選択を決定
　　　　　　StopEvent = True
　　　　　　ActiveTextBox.Text = Me.ListBox1.Text
　　　　　　Me.ListBox1.Visible = False
　　　　　　ActiveTextBox.SetFocus
　　　　　　KeyCode = 0
　　　　　　StopEvent = False
　　　　Case vbKeyEscape
　　　　　　'Escでリストを消す
　　　　　　StopEvent = True
　　　　　　Me.ListBox1.Visible = False
　　　　　　ActiveTextBox.SetFocus
　　　　　　StopEvent = False
　　End Select
End Sub

'TextBoxのChangeイベント共通処理
Private Sub TextBoxChange(ByVal ctl As Control)
　　Set ActiveTextBox = ctl
　　If StopEvent Then Exit Sub
　　
　　'未入力時は無視
　　If ctl.Text = "" Then
　　　　Me.ListBox1.Visible = False
　　　　Exit Sub
　　End If
　　
　　'リストに表示する配列を作成
　　Dim ary
　　ary = getListArray(ctl)
　　
　　'候補がない場合はリストボックスは表示しない
　　If UBound(ary) - LBound(ary) < 0 Then
　　　　Me.ListBox1.Visible = False
　　　　Exit Sub
　　End If
　　
　　'候補が1つで完全一致の場合はリストを表示しない
　　If UBound(ary) - LBound(ary) = 0 Then
　　　　If ctl.Text = ary(LBound(ary)) Then
　　　　　　Me.ListBox1.Visible = False
　　　　　　Exit Sub
　　　　End If
　　End If
　　
　　With Me.ListBox1
　　　　.List = ary
　　　　
　　　　'テキストボックスのすぐ下に同じ幅で表示
　　　　.Top = ctl.Top + ctl.Height
　　　　.Left = ctl.Left
　　　　.Width = ctl.Width
　　　　.Height = BaseHeight * .ListCount
　　　　'フォーム内に収める
　　　　If .Top + .Height > Me.InsideHeight Then
　　　　　　.Height = Me.InsideHeight - .Top
　　　　End If
　　　　
　　　　.Visible = True
　　End With
End Sub

'TextBoxのKeyDownイベント共通処理
Private Sub TextBoxKeyDown(ByVal ctl As Control, _
　　　　　　　　　　　　　 ByVal KeyCode As MSForms.ReturnInteger, _
　　　　　　　　　　　　　 ByVal Shift As Integer)
　　Select Case KeyCode
　　　　Case vbKeyReturn, vbKeyTab
　　　　　　'リストを非表示に
　　　　　　Me.ListBox1.Visible = False
　　　　Case vbKeyDown
　　　　　　'↓キーの時にリストにフォーカスを移す
　　　　　　If Me.ListBox1.Visible = True Then
　　　　　　　　On Error Resume Next '想定外を考慮
　　　　　　　　Me.ListBox1.SetFocus
　　　　　　　　On Error GoTo 0
　　　　　　　　Me.ListBox1.ListIndex = 0
　　　　　　End If
　　End Select
End Sub

'インクリメンタルサーチ
Private Function getListArray(ByVal ctl As Control) As Variant
　　Dim ary As Variant
　　
　　'テキストボックスによってリストを変更
　　ary = getListArrayByTextBox(ctl)
　　
　　'スペース1文字の場合はスペースを消して全リストを表示
　　If ctl.Text = " " Or ctl.Text = "　" Then
　　　　ctl.Text = ""
　　End If
　　
　　'Filterで部分一致で絞り込み
　　ary = Filter(ary, ctl.Text, True, vbTextCompare)
　　
　　getListArray = ary
End Function

'テキストボックスごとのリスト配列取得
Private Function getListArrayByTextBox(ByVal ctl As Control) As Variant
　　Dim ary
　　Select Case ctl.Name
　　　　Case "TextBox1"
　　　　　　ary = Worksheets("リスト").Range("A1:A30")
　　　　Case "TextBox2"
　　　　　　ary = Worksheets("リスト").Range("B1:B30")
　　　　Case Else
　　　　　　MsgBox "???"
　　End Select
　　
　　'Transposeで1次元配列に
　　getListArrayByTextBox = WorksheetFunction.Transpose(ary)
End Function

ユーザーフォームのVBAコードの解説

VBA内に入れたコメントを参考にして、流れをつかんでください。

イベントはテキストボックスの数だけ入れてください。
インクリメンタルサーチを実装するテキストボックスが大量にあるという事は無いと思います。
イベントを共通化できなくもありませんが、さすがにこの場合は不要だと思います。
第23回.イベントプロシージャーの共通化
・サンプルのユーザーフォーム ・イベントプロシージャーの共通化のVBA ・イベントプロシージャーの共通化の問題点 ・イベントプロシージャーの共通化の雛形VBA ・イベントプロシージャーの共通化の最後に
第24回.イベントプロシージャーの共通化（Enter,Exit）
・イベントプロシージャーの共通化の問題点 ・問題解決した経緯 ・API:ConnectToConnectionPointについて ・ConnectToConnectionPointの使用例 ・イベントと対応するVB_UserMemIdの一覧とインポート用雛形 ・イベントプロシージャーの共通化の最後に

細かい動作については、実際にVBAをコピーして動かしてみてください。

文字列検索に配列のFilter関数を使って簡単に実装しています。
Filter関数は、指定されたフィルタ条件に基づいた文字列配列のサブセット（一部分）を含むゼロベース（0開始）の配列を返します。Filter関数 Filter(sourcesrray,match[,include[,compare]]) sourcearray 必ず指定します。
ここは、大文字小文字を区別する等は適宜変更してください。

前方一致が良い場合もあるでしょう。
Filter関数ではなく配列をループで探すようにすれば、いろいろな検索方法にすることができますので、必要に応じて改変してみてください。

上のVBAではリストにない入力も許可しています。
リストにない入力は認めない場合の実装は、今回のリストボックスの使い方ではかなり難しくなります。
単純に、Exitイベントで処理しようとするとなかなかうまく動作させることが出来ません。
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
この中でCancel=Trueとした場合、フォーカスをリストボックスに移せなくなり、どうにも都合が悪いです。
今回の場合に限らず、ExitイベントでCancelすると、他のコントロールに移れなくなり実装がとても難しくなります。

最終的な入力確認は、必須項目の未入力チェックと合わせて最後に一括で行ったほうが良いでしょう。

インクリメンタルサーチの最後に

インクリメンタルサーチが実際にどれだけ便利なのかは良く検討したほうが良いでしょう。
そもそも、リストが大量にある場合は、グループ分けして多段階の絞り込みの方が良い場合も多いと思います。

インクリメンタルサーチは使い慣れると操作が早くなるかもしれませんが、操作不慣れな人にとって使いやすくなっているかは考える必要があります。
操作不慣れな人でも早く間違えずに入力できる仕組みはどのようなものか、これを良く検討して使ってみてください。


同じテーマ「ユーザーフォーム入門」の記事

第18回.２段階のコンボボックス
第19回.数値専用のテキストボックス
第20回.テキストボックスの各種イベント
第21回.ユーザーフォームの各種イベント
第22回.コントロールの動的作成
第23回.イベントプロシージャーの共通化
第24回.イベントプロシージャーの共通化（Enter,Exit）
第25回.簡易音楽プレーヤーの作成
第26回.プログレスバーを自作する
第27回.インクリメンタルサーチの実装
第28回.テンキーのスクリーンキーボード作成


新着記事NEW ・・・新着記事一覧を見る

TRIMRANGE関数（セル範囲をトリム：端の空白セルを除外）｜エクセル入門(2024-08-30)
正規表現関数（REGEXTEST,REGEXREPLACE,REGEXEXTRACT）｜エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない｜エクセル雑感(2024-04-11)
ブール型（Boolean）のis変数・フラグについて｜VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する｜VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次｜エクセルの神髄(2024-03-20)
VBA10大躓きポイント（初心者が躓きやすいポイント）｜VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成｜ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。｜エクセル雑感(2024-02-17)
初級脱出10問パック｜VBA練習問題(2024-01-24)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.繰り返し処理（For Next)｜VBA入門
3.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
4.変数宣言のDimとデータ型｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
7.セルのクリア（Clear,ClearContents）｜VBA入門
8.メッセージボックス(MsgBox関数)｜VBA入門
9.条件分岐（Select Case）｜VBA入門
10.ブック・シートの選択（Select,Activate）｜VBA入門



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ
同じテーマの記事
新着記事
アクセスランク


↑