VBAのリストボックスであいまい検索入力

Question

お世話になっております。検索ボックスを作成することになり、下記のサイトを参考にコードを書いています。
https://ukkari-ukachan.com/page-67
イメージしているものとしては下記の図のような仕様にしたいと考えています。

![]

リストボックスにはあらかじめ設定したワークシートの中のリストの値を反映させることは出来たのですが、

（１）あいまい検索のテキストボックスを入力して（この場合、「田」と検索したら中田、田中というあいまい検索の候補が出てくるはずがリストボックスが動作せず、候補が出てこない）

（２）試しに（１）の状態のテキストボックスに入力して（例え動作しなくとも）リストボックスの値を選択してもテキストボックスに値が反映されません。

特にエラー表示は出ていないのですが、備えたい機能が機能していない状態です。
VBAのLBound等の動的配列が関連しているかと思うのですが、VBA初心者で且つこの数日間の間にマクロファイルを用意しなければいけないの焦りを感じております。

もしも、このコードが動作しない原因やよりシンプルなリストボックスのあいまい検索のコードがありましたらご教示のほどをお願い致します。

Private Sub txtSchBox_Change()
    
    Dim arr()    As String   
    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.LstCandidate.List(i)
        i = i + 1
        If i = Me.LstCandidate.ListCount Then Exit Do
        ReDim Preserve arr(UBound(arr) + 1)
    Loop
    

    Me.LstCandidate.Clear

    search = Me.txtSchBox.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
    'using delimiter and change into array
    all = Split(all, ",")
 
    For i = LBound(all) To UBound(all)
        If Not all(i) Like "" Then
            Me.LstCandidate.AddItem all(i)
        End If
    Next
    
End Sub

Answer 1

なんか無駄に大変な処理をしているようにしか思えないです。
基本的にはテキストボックス変更のタイミングで、

1. リストボックスをクリア
2. リストの基になるデータから部分一致するデータをリストに登録

これだけでいいはずです。
以下はInitialize時に見えないリストボックス（Visible=False）に基データを作っておいて、そこから入力データに該当するリストを抽出しています。
面倒だったのでリストボックスにしていますが、ワークシートを参照するのでも考え方に違いはありません。

Private Sub TextBox1_Change()
    ListBox1.Clear
    ' ListBox2をワークシートの対象範囲に置き換えてもらえればOK
    For i = 0 To ListBox2.ListCount - 1
        If InStr(ListBox2.List(i), TextBox1.Text) > 0 Then
            ListBox1.AddItem ListBox2.List(i)
        End If
    Next
    
End Sub

' テストデータ作成
Private Sub UserForm_Initialize()
    ListBox2.AddItem "あいうえを"
    ListBox2.AddItem "かきくけこ"
    ListBox2.AddItem "ああいいう"
    ListBox2.AddItem "いいううえ"
    ListBox2.AddItem "えおおかか"
    
    For i = 0 To ListBox2.ListCount - 1
        ListBox1.AddItem ListBox2.List(i)
    Next
End Sub

.

Comments

[asian-ayam]

ご回答下さり、有難うございます！シンプルな構文で非常に勉強になります！

Answer 2

リストボックスにはあらかじめ設定したワークシートの中のリストの値を反映させることは出来たのですが、

これはどのタイミングでしてますか。UserForm_Initialize ですか。

呈示のコードは、テキストボックスに入力した値と部分一致するデータがリストボックスにあったらリストの先頭へ移動するというものですが、事前にリストボックスにリストを設定しておけば、正常に動作しました。（リンク先にもそのような動作という説明があります。）

もし、最初はリストボックスは空欄で、テキストボックスに入力した値と部分一致するものをリストボックスに表示させたいということなら一からコードを書き直す必要があります。

上記のような仕様の場合のコード例
ただし、最初（テキストボックスが空欄）の場合は、全リストを表示することにしました。
（その方が使いやすいだろうということで）

ユーザーフォームのモジュール

Option Explicit
Private aryList As Variant

Private Sub LstCandidate_Click()
    Me.txtSchBox.Value = Me.LstCandidate.Value
End Sub

Private Sub txtSchBox_Change()
    Dim search As String
    search = Me.txtSchBox.Value
    If search = "" Then '空欄の場合は全リスト表示
        Me.LstCandidate.List = aryList
        Exit Sub
    End If

    Me.LstCandidate.Clear
    search = "*" & Me.txtSchBox.Value & "*"
    
    Dim Itm As Variant
    For Each Itm In aryList
        If Itm Like search Then
            Me.LstCandidate.AddItem Itm
        End If
    Next
End Sub

Private Sub UserForm_Initialize()
    aryList = Worksheets(1).Range("A1:A10").Value 'シートのリスト
    Me.LstCandidate.List = aryList
End Sub

Comments

[asian-ayam]

ご回答下さり、有難うございます！あいまい検索のコードと該当する候補以外は消えていく仕組みも非常に助かりました！ちなみにこのあいまい検索のワイルドカードの設定はテキストボックスの入力された文字、例えばTanakaと入力したら"naka"の部分だけを拾ってくるので先頭文字が一致するTanakaが出てこず、Nakataが出てくる設定になっているかと思うのですが、現在のあいまい検索＋先頭一致の場合で候補が出てくるようにしたいのですが、どのようなコードを書けばよろしいでしょうか？いくつかIf構文とAndで条件を繋げてみたのですが、上手くいかずに詰まってしまっております。。。

[MrIgat]

先頭一文字だけでよいのであればこれでいかがですか。
If Itm Like search Or Left(UCase(Me.txtSchBox.Value), 1) = Left(UCase(CStr(Itm)), 1) Then

[hatena19]

> 例えばTanakaと入力したら"naka"の部分だけを拾ってくるので先頭文字が一致するTanakaが出てこず、Nakataが出てくる設定になっているかと思うのですが

そんなことはないです。部分一致ですので、先頭一致でもでてきます。

[MrIgat]

おそらく、大文字小文字の区別をせずに検索したいという意味のような気がするので、hatena19さんのコードの
search = "*" & UCase(Me.txtSchBox.Value) & "*"　と
If UCase(Itm) Like search Then
の2行を変更するとよい気がする。

[hatena19]

> おそらく、大文字小文字の区別をせずに検索したいという意味のような気がするので、

質問文やコメントだけからはそう読み取るのは難しいですが、そうだとすると、
モジュールの先頭に、
Option Compare Text
と宣言するのもひとつの手ですね。ただ、こうするとひらがなとカタカナも区別しなくなりますが。

[asian-ayam]

返信が遅くなりました！部分一致のワイルドカードということで認識は合っていたのですね！質問例では日本人の名前を検索というように記載してしまいましたが、実際、作りたいものは外国人の名前が入っているリストなのでアルファベットの大文字と小文字の組み合わせで出来ています（本来はこの検索したい文字の種類にも注意すべきでした）hatena19さんのおっしゃるようにOption Compare Textと宣言したところ、例えばnakaと入力すると候補としてTanakaとNakataが出てくるようになりました！ここ数日間、格闘していたのでイメージ通りになり、喜びは一入です！皆様、ご回答下さり有難うございました！