VBA listBoxについて

動作としてはTextBox1に検索対象(管理№例100053)を入力（完全一致ではなく一部入力でも）該当する№がリストボックスに表示します
表示したリストから該当の№をクリックしたらsheet1のＢ列にカーソルが移動した対象を確認、
その№行の指定したセルに転記させるというながれになります
検索対象の桁数があるので下桁でも表示はするのですが
クリックしてカーソルがその対象とは違うところに移動してしまいます
問題なく動くときは頭の１桁検索しスクロールで対象をクリックした時になります
現状はこのようになってます
どのようにしたら改善するのでしょうか？(´;ω;｀)
Private Sub TextBox1_Change()
' TextBox入力した時の処理

Dim i As Long
Dim Mydata As Variant
Dim lastRow As Long
Dim Cnt As Long
Dim searchTerm As String
Dim listBoxIndex As Integer

' 配列カウント初期化
Cnt = 1

' 最終行を取得
lastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 2).End(xlUp).Row

' 2次元配列の要素数を変更
ReDim Mydata(1 To lastRow, 1 To 20)

' 検索対象が空の場合は処理を終了
searchTerm = Me.TextBox1.text
If Len(searchTerm) = 0 Then Exit Sub

For i = 1 To lastRow
If InStr(1, Sheets("Sheet1").Cells(i, 2), searchTerm) > 0 Then
' 配列に列の値と、セル番号を格納
Mydata(Cnt, 1) = i + 1
Mydata(Cnt, 2) = Cells(i, 2)
Mydata(Cnt, 3) = Cells(i, 3)
Mydata(Cnt, 4) = Cells(i, 4)
Mydata(Cnt, 5) = Cells(i, 5)
Mydata(Cnt, 6) = Cells(i, 6)
Mydata(Cnt, 7) = Cells(i, 7)
Mydata(Cnt, 8) = Cells(i, 8)
Mydata(Cnt, 9) = Cells(i, 9)
Mydata(Cnt, 10) = Cells(i, 10)
Mydata(Cnt, 11) = Cells(i, 11)
Mydata(Cnt, 12) = Cells(i, 12)
Mydata(Cnt, 13) = Cells(i, 13)
Mydata(Cnt, 14) = Cells(i, 14)
Mydata(Cnt, 15) = Cells(i, 15)
Mydata(Cnt, 16) = Cells(i, 16)
Mydata(Cnt, 17) = Cells(i, 17)
Mydata(Cnt, 18) = Cells(i, 18)
Mydata(Cnt, 19) = Cells(i, 19)
Mydata(Cnt, 20) = Cells(i, 20)
' 他の列のデータも同様に追加
' ...
' 配列カウント増加
Cnt = Cnt + 1
End If
Next i

' 検索で一致したデータをリストボックスに表示
With ListBox1
.ColumnCount = 20
.ColumnWidths = "30;55;40;0;150;90;130;130;0;0;60;150;0;0;0;0;120,60,130,30"
.List = Mydata
End With
End Sub
Private Sub ListBox1_Click()
' リストボックス内をクリックして該当セルを選択

Dim rowIndex As Integer
Dim targetCell As Range

' 選択された項目の行番号を取得
rowIndex = ListBox1.ListIndex + 2

' 対応するセルを選択
Set targetCell = Sheets("Sheet1").Cells(rowIndex, 2)
targetCell.Select
End Sub
Private Sub CommandButton1_Click()
Dim selectedRow As Integer
Dim r As Integer

If Me.ComboBox6 = "" Then
MsgBox "管理場所が入力されてません"
Exit Sub
End If
If Me.ComboBox7 = "" Then
MsgBox "担当者が入力されてません"
Exit Sub
End If

' リストボックス内で選択された行のインデックスを取得
selectedRow = ListBox1.ListIndex

For r = 2 To Cells(Rows.Count, "B").End(xlUp).Row
If ListBox1.ListIndex = r - 2 Then ' 選択された行が有効かどうかを確認
' 選択された行に基づいてデータを転記
Cells(r, 18).Value = Me.TextBox4.Value
Cells(r, 19).Value = Me.ComboBox6.Value
Cells(r, 20).Value = Me.ComboBox7.Value
Cells(r, 21).Value = Me.TextBox2.Value

' 選択された行をリストボックスから削除
ListBox1.RemoveItem r - 2
Exit For ' 処理が完了したらループを終了
End If
Next r
End Sub

No.2 ベストアンサー 回答者： fujillin 回答日時： 2024/03/27 10:42

No1です。

＞転記するときにコンパイルエラーが出るようになりましたが・・・
それって、No1で回答した「Private Sub ListBox1_Click()」とは別のプロシージャの話ですよね？

No1の回答は「セルの選択」をご質問のようにしているだけで、後は何も変えていませんので、他のプロシージャに影響はしないはずです。
それに、「コンパイルエラー」なら、質問文にご提示のままでも出ていたはずだと思いますけれど・・？

この回答へのお礼

すみません、こちらで追記してたのでなんの落ち度はありませんm(_ _)m
ありがとうございました!

お礼日時：2024/03/27 13:10

No.1 回答者： fujillin 回答日時： 2024/03/26 17:30

こんばんは

＞クリックしてカーソルがその対象とは違うところに移動してしまいます
ご質問はこの部分だけと解釈しました。（他は見ていません）

ご質問の内容とは直接関係はありませんけれど、該当するものをリストボックスに抽出した際に、行番号（？）を表示していますけれど、実際の行番号とはずれていますが、それは意図通りってことで良いのでしょうか？
まぁ、それはそのままという事にしておいて・・

クリックした際の処理は、
＞Private Sub ListBox1_Click()
に記されていると思いますが、その内容を以下のようににすると、ご質問のような動作になるのではないでしょうか。

Dim rowIndex As Integer
rowIndex = ListBox1.ListIndex
If rowIndex > -1 Then _
Worksheets("Sheet1").Cells(ListBox1.List(rowIndex, 0) - 1, 2).Select

この回答へのお礼

ありがとうございましたm(__)m
クリックで指定した所にちゃんと行くようになりました
転記するときにコンパイルエラーが出るようになりましたが・・・

お礼日時：2024/03/27 09:49