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

Excelマクロのユーザーフォームの基礎、エクセルVBAの入門解説
最終更新日: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で同じイベントプロシージャーを何個も作成しなければならなくなります。
第24回.イベントプロシージャーの共通化(Enter,Exit)
ユーザーフォームのVBAでは、同じイベントプロシージャーを何個も作成することが多々あります。テキストボックスを複数個配置して同じイベント処理を実装する時、全く同じイベントプロシージャーをコピペで何個も作るといったことが必要になります。その解決方法として前回、第23回.イベントプロシージャーの共通化 WithEventを使った方法を紹介しましたが、

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

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

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

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

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

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

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

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



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

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


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

タプル(tuple型、イミュータブル)|Python入門(9月15日)
リスト(list型、配列)|Python入門(9月14日)
文字列操作(str型)|Python入門(9月13日)
greeenはgreenに、greeeeeNをGReeeeNに変換|エクセル雑感(9月13日)
while文とデバッグ(ステップイン)|Python入門(9月12日)
入力規則で○△を入れる数を制限する方法|エクセル雑感(9月12日)
コレクションの要素を削除する場合|エクセル雑感(9月11日)
for文とイテラブルオブジェクト|Python入門(9月10日)
if文とインデントによるブロック|Python入門(9月9日)
ショートカット(Ctrl+Shift+n)抜け番ばどれだ|エクセル雑感(9月8日)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
7.繰り返し処理(For Next)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.とにかく書いてみよう(Sub,End Sub)|VBA入門
10.マクロはどこに書くの(VBEの起動)|VBA入門




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


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



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