EXCELのフォーム上でリアルタイムな曖昧検索を行いたい

質問

ユーザーフォーム上でのVBAを教えて頂きたく思い、投稿致します。
現在、特定のセルをダブルクリックしユーザーフォームを呼び出し
指定範囲からデータを取得し、リストボックス上に表示させる。
Private Sub UserForm_Activate()
With Worksheets("データシート").Range("A1").CurrentRegion
Me.ListBox1.RowSource = .Resize(.Rows.Count - 1 _
).Offset(2, 0).Address(external:=True)
End With
End Sub
という物を利用し、フォーム上で決定された値を、特定セルに戻す
（入力する）という作業を行っているのですが、
フォーム上での数値決定を、あいまい検索かつ、リアルタイムに
変動するように出来ないでしょうか？
下記のような流れをイメージしております。

1.テキストボックスに検索内容を入力（対象は指定範囲）
2.入力された文字に応じて、リストボックスのデータを変動させる。
3.数値を決定しセルに反映。

2.のデータ変動ですが、以下のようなデータがあった場合、
1.AABBCC
2.AABCCD
3.AACCDD

入力値[AA] =1,2,3
入力値[AAB] =1,2
入力値[AABB]=1
という表示が、入力した瞬間に返ってくるような物は可能でしょうか？
2を色々調べたのですが、これだ！という物に出会えませんでしたので
ご教授お願い致します。

回答No.3

redfox63 · ベストアンサー

ListBoxのRowSourceでは複数の領域を設定できないようです
やるなら Listプロパティをつかって設定といった方向でしょう

データ範囲のRangeオブジェクトのValueプロパティでシートのデータを取得
取得した配列をループしてテキストボックスに部分文字列があるか探索およびコレクションする
探索して出来上がったコレクションを ListBoxのListプロパティへ設定
といった手順でしょう

テキストボックスの Changeイベントで
dim ar(), dt()
dim n as integer, m as integer
with Range("A1").CurrentRegion
　　' シートから元データを取得
　　ar = .Resize( .rows.Count-1, 1).Offset(2,0).value
end with
Redim dt( UBound(ar) - 1 )
m = -1
for n = LBound( ar ), Ubound(ar)
　　' 部分文字列があるかを判定
　　if instr( ar(n,1), TextBox1.text then
　　　　m = m + 1
　　　　dt(m) = ar(n,1)
　　end if
next

if m = -1 then
　　' テキストボックスに入力があるが該当行がない場合
　　listBox1.RowSource = ""
　　ListBox1.Clear
　　exit sub
end if

' 見つかったデータをListBoxに設定する
redim ar(m,0)
for n = 0 to m
　　ar(n,0) = dt(n)
next
listBox1.rowsource = ""
ListBox1.List = ar
といった具合でしょう

お礼

redfox63様のおかげで、試行錯誤の末、
望む物が完成しました！

また皆様のお力を借りる時があるかと思いますが、
その時はご教授下さい。

本当にありがとうございました。

補足

回答ありがとうございます。
上記の分で思った動作が出来ました！

ただ[Redim]など使った事のない関数が出てきましたので、
色々と検索し、自分なりにコメントを付けて処理を追いかけてみました。
（自分の提示した処理の範囲と、ar = 範囲 と変更してあります）
処理の認識等があってるかどうかを教えて頂けますでしょうか？

Private Sub TextBox1_Change()

Dim 範囲(), dt()
Dim n As Integer, m As Integer

'アクティブセル領域の取得
With Range("A1").CurrentRegion
' シートから元データを取得
範囲 = .Resize(.Rows.Count, 1).Value
End With

ReDim dt(UBound(範囲) - 1) '配列で検索した数値の数だけ変数を作成。上限-1(？)
m = -1 '検索値の個数判定

For n = LBound(範囲) To UBound(範囲) '範囲の下限から上限をループ
' 部分文字列があるかを判定
If InStr(範囲(n, 1), TextBox1.Text) Then 'n行の1列目をTextBox1の値で検索
m = m + 1
dt(m) = 範囲(n, 1) 'HITした行を変数に格納
End If
Next

If m = -1 Then
' テキストボックスに入力があるが該当行がない場合
ListBox1.RowSource = ""
ListBox1.Clear
Exit Sub
End If

不明なのは「ReDim dt(UBound(範囲) - 1)」の部分で、
「-1」はどういう役目があるのでしょうか？
最初に自分が記載したコードの
.Resize(.Rows.Count - 1).Offset(2, 0)
部分と同じ内容（こちらの処理に合わせて書いて頂いた）
という認識ですので、こちらも認識が間違っていればご指摘頂きたいです。

回答No.2

imogasi

才走った質問の書き方だが、順序だてて飛躍なしにかけないですか。
過度に記号化せず、現実の匂いを残した例がかけないか？
（１）第１ステップ
テキストボックスに
AA
AAB
AABB
などどれか１つを入れる。何種類ぐらいあるのか？
（２）第２ステップ
＞入力された文字に応じて、リストボックスのデータを変動させる。
とは実際例ではどうなるのか。
AAであればあれとこれとト言う風に決まっているのですか？
それはセル範囲にあるのか、配列などで持つのか。ファイルなどもありえると思うが。
ここでリストボックスにデータをセットするということは、素の中かrら選択させるのか。且つマルチセレクト？
ここが１対１対応ならば、結果も数種に決まるように思うが
AA-->関数関係で決定ーー＞AABBCCーー＞都度選択ーー＞選択されたら
AAを含むことは判っているーー＞１，２，３のどこかへ入ることは確実。AABBCCがBBBBBなら、含まれないから番号に上がらないことは確実。

（３）第３ステップ
選択したリストの中にAAなど文字列を含むものの順序番号をセルに書き出すのか？ここをもう少し意味のある語句で公開できないのか。
あいまい検索など大きい言葉を使っているが、その語句が含まれておれば、その番号（何を意味するのかわからないが）をセルに、ペアとして書き出すらしいが、すっきり判らない。

お礼

無事完成させる事が出来ました。
ありがとうございます。

補足

説明のしかたがわかりにくくて申し訳ありません。
フォームの概要としましては、以下の内容となります。
1.テキストボックス1 = 検索値を入力
2.リストボックス1(?)= 検索結果を表示
3.テキストボックス2 = リストボックスで選択された数値を表示
4.コマンドボタン1 = テキストボックス2で選択された数値をセルに代入

（１）第１ステップ
検索値となりますので、値は可変です。
商品名を検索する時もあれば、メーカー名を検索する時ありますので
何種類くらい？というのは断定できません。
（２）第２ステップ
検索対象はセルで範囲はA1セル～A500セルと仮定します。
A1:おおさか
A2:おおいた
A3:おかやま
のデータが検索対象に入力されている場合、
テキストボックス1にデータを入力している最中に
リストボックス1のデータを変動させたいのです。

テキストボックス1= リストボックス1の表示
「お」= おおさか,おおいた,おかやま
「おお」= おおさか,おおいた
「おおさ」= おおさか
「おおさじ」=表示無し

検索されたリストが複数の場合もありますので、その中から任意の
一つを選択肢、セルに反映させるイメージです。

（３）第３ステップ
範囲内の検索値を含むセルをリストボックスにリストアップする。
という内容です。前回は【AABBCC=1】と番号は省略した為
わかり難くなってしまい大変申し訳ありません。
こちらの説明で伝わるでしょうか？説明下手で本当にすいません。

回答No.1

nda23

テキストボックスのChangeイベントで実行すれば如何ですか？

お礼

無事完成させる事が出来ました。
ありがとうございます。

補足

テキストボックスのChangeイベントで入力した値を、毎回検索するという事でしょうか？

それが可能なら解決するような気もしますが
まだ勉強中ですので一度調べてみます。