VBAにてリストボックスで選択すると別ブックにあるデータを個別の窓へ表示させるには？

質問

はじめまして、ゴールデンウィーク中にVBAを勉強していますが、上手くいきません。内容は、「UserForm1を使って別シートにあるデーターから検索を行い、ListBox1に抽出されたリストを選択すると個別のTextBox2に関連する詳細を表示させる」というものです。別シートには「顧客データ」があり、A列より「担当、氏名、カタナカ、住所、電話番号・・・」とデーターが並んでいます。中途半端な状態ですが、これ以上進めません。だれか助けてください。

Private Sub CommandButton1_Click()
Dim Namae As String
Dim MeNamae As Object
Dim ken As String

Namae = TextBox1.Text
Set MeNamae = UserForm1
Call 検索(Namae, MeNamae)

End Sub
'受付画面に検索画面窓を出し、顧客データから検索した結果を出すマクロ
Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object)
Dim Nagasa As Integer
Dim i As Long
Dim MaxRows As Long
Dim kensaku As Object
Dim KensakuChar As String
Dim ListNamae As String
Dim ListChar As String
Dim KBanme As Integer
Dim LBanme As Integer

Set kensaku = Worksheets("顧客データ")
MaxRows = kensaku.UsedRange.Rows.Count
Nagasa = Len(Namae)

MeNamae.ListBox1.Clear

For i = 3 To MaxRows
ListNamae = kensaku.Cells(i, 3)
KBanme = 0
LBanme = 0
Do
Do While Nagasa >= KBanme
KBanme = KBanme + 1
KensakuChar = Mid(Namae, KBanme, 1)
If KensakuChar <> " " Then
Exit Do
End If
Loop
Do While Nagasa >= LBanme
LBanme = LBanme + 1
ListChar = Mid(ListNamae, LBanme, 1)
If ListChar <> " " Then
Exit Do
End If
Loop

If KensakuChar = ListChar Then
If Nagasa = KBanme Then
With MeNamae
.ListBox1.AddItem (ListNamae)
End With
End If
Else
Exit Do
End If
Loop Until Nagasa <= KBanme
Next

End Sub

Private Sub ListBox1_Click()
With ListBox1
If .ListIndex > -1 Then
TextBox2.Value = .List(.ListIndex, 0)’←これでは何の意味も無い
' TextBox2.Value = kensaku.Cells(kensakuIndex, 3)
' TextBox2.Value = kensaku.Cells(kensaku, 3)
' TextBox2.Text = kokyaku.Hoken4
'　　　　　　TextBox2.Text = kokyaku.Cells(i, 5)

End If
End With

End Sub

回答No.1

fumufumu_2006 · ベストアンサー

こんな方法はどうでしょうか？

見つけた名前をリストに追加する時に、その行も記録します。
.ListBox1.AddItem (ListNamae)
の次の行に
.ListBox1.List(.ListBox1.ListCount - 1, 1) = i
を追加します。
これで、名前リストを見つけた行も記録します。
List()の引数は0から始まるので.ListBox1.ListCount-1に記録します。
プロパティウインドウでTextBox2のMultiLineをTrueにして、ListBox1_Click()の部分を以下にしてみてください。
Private Sub ListBox1_Click()
Dim r As Long
With ListBox1
If .ListIndex > -1 Then
r = .List(.ListIndex, 1) '選択した名前の行
TextBox2.Value = Worksheets("顧客データ").Cells(r, 4) & vbCrLf & Worksheets("顧客データ").Cells(r, 5)
End If
End With
End Sub

p.s.
Dim MeNamae As Object
Dim kensaku As Object
Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object)
の、As Objectは、できるだけ避けた方がいいと思います。
Dim MeNamae As UserForm
Dim kensaku As Worksheet
Public Sub 検索(ByVal Namae As String, ByRef MeNamae As UserForm)
にすれば、VBEの入力支援機能が機能して、入力が楽になり、エラーも見つけやすくなると思います。

お礼

こちらの手違いでした。動作は完璧です。まさに理想通りにうごきました。動かないと思っていたのはテキストボックスが小さかった為見えなかったからでした。大変失礼いたしました。すみませんでした。また、大変感謝いたしております。

補足

早速のお返事とても感謝いたしております。
記述を以下のように変更いたしましたが、「TextBox2」に表示もされずまた、終了もされません。まだ何か間違いなどありますでしょうか？
大変お手数ですが、再度お返事よろしくお願い致します。

Private Sub CommandButton1_Click()
Dim Namae As String
Dim MeNamae As UserForm
Dim ken As String

Namae = TextBox1.Text
Set MeNamae = UserForm1
Call 検索(Namae, MeNamae)

End Sub
Public Sub 検索(ByVal Namae As String, ByRef MeNamae As UserForm)
Dim Nagasa As Integer
Dim i As Long
Dim MaxRows As Long
Dim kensaku As Worksheet
Dim KensakuChar As String
Dim ListNamae As String
Dim ListChar As String
Dim KBanme As Integer
Dim LBanme As Integer

Set kensaku = Worksheets("顧客データ")
MaxRows = kensaku.UsedRange.Rows.Count
Nagasa = Len(Namae)

MeNamae.ListBox1.Clear

For i = 3 To MaxRows
ListNamae = kensaku.Cells(i, 3)
KBanme = 0
LBanme = 0
Do
Do While Nagasa >= KBanme
KBanme = KBanme + 1
KensakuChar = Mid(Namae, KBanme, 1)
If KensakuChar <> " " Then
Exit Do
End If
Loop
Do While Nagasa >= LBanme
LBanme = LBanme + 1
ListChar = Mid(ListNamae, LBanme, 1)
If ListChar <> " " Then
Exit Do
End If
Loop

If KensakuChar = ListChar Then
If Nagasa = KBanme Then
With MeNamae
.ListBox1.AddItem (ListNamae)
.ListBox1.List(.ListBox1.ListCount - 1, 1) = i
End With
End If
Else
Exit Do
End If
Loop Until Nagasa <= KBanme
Next

End Sub
Private Sub ListBox1_Click()
Dim r As Long
With ListBox1
If .ListIndex > -1 Then
r = .List(.ListIndex, 1) '選択した名前の行
TextBox2.Value = Worksheets("顧客データ").Cells(r, 4) & vbCrLf & Worksheets("顧客データ").Cells(r, 5)
End If
End With
End Sub

回答No.2

imogasi

もう判ったようだが、折角やってみたので載せておく。
自分の作ったコードのコピーを貼り付けて、読者に読み解かせるのでなく
下記のような解説が必要と思う。
ーー
顧客データシート
担当 会社 所在地 業種 年商
係Ａ 山田産業 喜多町 衣類販売 20
係Ｂ 小池商事 本町 食料品卸 35
課長 北野 新宿町 紙製品 15
係Ｃ 近藤組 諏訪町 建設解体 10
係Ａ 北村機械 北公園 輸送機械 25
課長 南塗料 新町 塗料卸 8
係Ｂ 島田製菓 八幡町 菓子製造 15
係Ａ 北モータス 学園町 クルマ修理 7
係Ａ 西食品 本郷 食品加工 25
ーーーー
（道具だて）
ＵｓｅｒＦｏｒｍ１を１つ挿入する。
その上のコントロールは
検索語を入力用ーーーテキストボックス
選択用アイテム表示ーリストボックス
検索開始のトリガーーコマンドボタン
リストボックス選択後の内容表示用ーーテキストボックス３つ
ーーーー
（処理の流れ）
textBox1に検索語を入れる
コマンドボタンクリック
顧客データシート検索
候補リストをリストボックスのアイテムとして表示
リストボックスにリストから選択
決定内容（顧客データ）の特定の行の項目をテキスト
ボックスに表示
ーーー
（コード）
標準モジュールに
Public gyo(10)
を入れる
ーーー
リストボックスの選択の前まで
Private Sub CommandButton1_Click()
Dim Namae As String
Dim MeNamae As Object
Dim ken As String

Namae = TextBox1.Text
Set MeNamae = UserForm1
Call 検索(Namae, MeNamae)

End Sub
'---
Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object)
Dim Nagasa As Integer
Dim i As Long
Dim MaxRows As Long
Dim kensaku As Worksheet
Dim KensakuChar As String
Dim ListNamae As String
Dim ListChar As String
Dim KBanme As Integer
Dim LBanme As Integer

Set kensaku = Worksheets("顧客データ")
MaxRows = kensaku.UsedRange.Rows.Count
Nagasa = Len(Namae)
MsgBox MaxRows
MeNamae.ListBox1.Clear
j = 0

For i = 2 To MaxRows + 1
If kensaku.Cells(i, "A") = Namae Then
With MeNamae.ListBox1
.AddItem
.List(j, 0) = kensaku.Cells(i, "B")
.List(j, 1) = kensaku.Cells(i, "C")
' & kensaku.Cells(i, "B") & kensaku.Cells(i, "C")
j = j + 1
End With
End If
Next i

End Sub
ーーー
選択後の詳細データ表示は
（１）再検索法
（２）Public変数に保持法
（３）ＬｉｓｔＢｏｘの列に保持法
（４）配列データ引数引渡し
など考えられるが、本件は（２）でやった。
ーー
Private Sub ListBox1_Click()
Set kensaku = Worksheets("顧客データ")
With ListBox1
If .ListIndex > -1 Then
x = ListBox1.ListIndex
'MsgBox x
MsgBox gyo(x + 1)
TextBox2.Value = .List(.ListIndex, 0)
TextBox3.Value = .List(.ListIndex, 1)
TextBox4.Value = kensaku.Cells(gyo(x + 1), 4)
TextBox5.Value = kensaku.Cells(gyo(x + 1), 5)
End If
End With
End Sub
ーーー
（操作例）
テキストに「係Ａ」と入力
リストボックスに
山田産業
北村機機械
北モータース
西食品
が出る
例えば北村機械をクリックすると、各テキストボックスに
北村機械
北公園
輸送機械
２５
が出る。

お礼

親切な回答ありがとうございます。詳しければ詳しいほど初心者である私には今後につなげることができます。これからも詳しい回答を期待しております。この度はありがとうございました。