VBA リストボックス反映できない

エクセルVBA がうまく作動しません。

入力したいセルをクリックすると、ユーザーフォームが開き、ふりがなの部分一致検索で顧客名(漢字)と住所が表示されクリックすると、セルに顧客名(漢字)が表示されるVBA を作りたかったのですが…

問題①リストボックスをクリックしてもセルに反映していない

わかる方、ご指導お願いします。

Sheet1に入力したいセルがあります。
Sheet2のA列に顧客コード、B列に顧客名(漢字)、C列にふりがな、D列に住所が入っています。

Const 顧客一覧の見出し行 As Long = 1

Const 顧客番号の列番号 As Long = 1
Const 顧客名漢字の列番号 As Long = 2
Const 顧客名ふりがなの列番号 As Long = 3
Const 住所の列番号 As Long = 4

Const セルに転記するリストボックスの列番号 As Long = 2 '顧客名=1 住所=2

Const 入力シートの名前 As String = "Sheet1"
Const 顧客一覧シートの名前 As String = "Sheet2"

Private 入力シート As Worksheet
Private 顧客一覧シート As Worksheet

'リストボックスがクリックされたら
Private Sub ListBox1_Click()

'リストに何も無ければ処理を抜ける
If ListBox1.Text = "" Then Exit Sub

'選択中のセルに顧客名を入力する
ActiveCell.Value = ListBox1.List(ListBox1.ListIndex, セルに転記するリストボックスの列番号 - 1)
End Sub

'入力フォームの初期化時
Private Sub UserForm_Initialize()

Set 入力シート = ThisWorkbook.Sheets(入力シートの名前)
Set 顧客一覧シート = ThisWorkbook.Sheets(顧客一覧シートの名前)

End Sub

'ふりがな入力用テキストボックス　の中身が変わったら
Private Sub TextBox1_Change()

Dim 探すふりがな As String

'テキストボックスの内容から前後のスペースを取り除いて変数に入れる
探すふりがな = Trim(TextBox1.Value)

'空白なら何もせず処理を抜ける
If 探すふりがな = "" Then Exit Sub

'リストボックスをクリアする
ListBox1.Clear

'ふりがなが一致する顧客番号を集める
Dim 行番号たち() As Long: 行番号たち = ふりがなが一致する顧客を含む行番号たちをゲット(探すふりがな)

'1件も見つからなかった場合は処理を抜ける
If UBound(行番号たち) = 0 Then Exit Sub

'ふりがなが一致する顧客の情報をリストボックスに表示する
リストボックスをセットする 行番号たち

End Sub
Private Sub リストボックスをセットする(行番号たち() As Long)

ListBox1.ColumnCount = 2

ReDim リスト(UBound(行番号たち), 1)

Dim i As Long

For i = 1 To UBound(行番号たち)
リスト(i - 1, 0) = 顧客一覧シート.Cells(行番号たち(i), 顧客名漢字の列番号)
リスト(i - 1, 1) = 顧客一覧シート.Cells(行番号たち(i), 住所の列番号)
Next
ListBox1.List = リスト
End Sub


Private Function ふりがなが一致する顧客を含む行番号たちをゲット(探すふりがな As String) As Long()

Dim 一番最後の行番号 As Long: 一番最後の行番号 = 一番最後の行番号をゲット
ReDim 行番号たち(0) As Long
Dim i As Long, cnt As Long


'顧客一覧の中から一行ずつふりがなが一致する顧客番号を探す

For i = 顧客一覧の見出し行 + 1 To 一番最後の行番号

'この行のふりがな
Dim ふりがな As String: ふりがな = 顧客一覧シート.Cells(i, 顧客名ふりがなの列番号)

'この行のふりがながテキストボックスの入力内容を含む場合
If ふりがな Like "*" & 探すふりがな & "*" Then

cnt = cnt + 1
ReDim Preserve 行番号たち(cnt) '配列の要素を一つ増やす
行番号たち(UBound(行番号たち)) = i '配列の最後の要素に行番号を入れる

End If

Next

ふりがなが一致する顧客を含む行番号たちをゲット = 行番号たち

End Function

Private Function 一番最後の行番号をゲット() As Long
一番最後の行番号をゲット = 顧客一覧シート.Cells(2, 顧客名ふりがなの列番号).End(xlDown).Row
End Function

No.2 ベストアンサー 回答者： ggrksdqn 回答日時： 2020/11/21 14:34

そのコードの作者です。

このコードのままだと、住所が転記されるはずです。
次の定数を1に変更してください。

Const セルに転記するリストボックスの列番号 As Long = 2 '顧客名=1 住所=1

転記する項目を後から変更できるようにしていましたが、定数を顧客名(1)に戻すのを忘れていました。すみません。

この回答へのお礼

何から何までありがとうございます！！！

お礼日時：2020/11/21 17:13

No.1 回答者： fujillin 回答日時： 2020/11/20 23:24

こんばんは

コードはほとんど見ていませんが・・・

＞問題①リストボックスをクリックしてもセルに反映していない
とおっしゃるのは、ここ（↓）のことでしょうか？
＞Private Sub ListBox1_Click()
＞If ListBox1.Text = "" Then Exit Sub
＞ActiveCell.Value = ListBox1.List(ListBox1.ListIndex, セルに転記するリストボックスの列番号 - 1)
＞End Sub
実質たったの2行しかないので、デバッグも簡単では？
　・そもそもListBox1になにも入っていないか
　（というか、次にList属性を読んでるけど、Text属性に何か入っているのが正しいのでしょうか？）
　・ListBox1.Listの参照位置を間違っているか
　・参照位置を位置は合っているけれど、空文字になっているか
辺りではないのでしょうか？
（それまでの処理がどうなっているのか知りませんけれど）
まさか、ActiveCellがとんでもないところになっているとかのオチではないですよね？

これだけ丁寧にコメントを入れて作成なさっているのですから、ご自分で直ぐに気がつかれるものと思いますけれど。
単なる思い込みで、チェックし忘れている所があるだけではないのでしょうか？
それとも、実際の原因は別のところにあるのを、「クリックイベントに問題あり」と勘違いなさっているのか・・・