【Excel VBA】検索フォームの不具合の原因教えて下さい。

インターネットから参照したコードを使用して検索フォームを作成しました。
動くは動くのですが、以下のような不具合が発生してにっちもさっちもいきません。
使用している検索フォームに関連するコードですが、どこがおかしいのでしょうか？
VBA初心者のため、どなたか教えてください。
不具合：ﾃｷｽﾄﾎﾞｯｸｽで品目の一部分を入力し、データを絞り込むと2列目のデータとタイトルがリストに表示されません

■ｺｰﾄﾞ
'フォームを開いた時の処理
Private Sub UserForm_Initialize()

Dim wLastGyou As Long

'最終行番号を取得
wLastGyou = Worksheets("Sheet1").UsedRange.Rows.Count
'リストボックスに「品目」のリストをセット
With ListBox1
.ColumnCount = 2
.ColumnWidths = "100;20"
.ColumnHeads = True
'リストボックスの値にセルA2からA最終行までセット
.RowSource = "Sheet1!A2:B" & wLastGyou
End With
End Sub

'検索用のテキストボックス更新後の処理

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim Obj As Object
Dim wAddST As Variant
Dim wAddress As Variant
Dim wKamoku As Variant

With Worksheets("Sheet1")
'テキストボックスの値が含まれるセルを検索
Set Obj = .Cells.Find(what:=TextBox1.Value, _
LookIn:=xlValues, _
lookat:=xlPart, _
matchbyte:=False)
'検索対象がない場合はメッセージを表示
If Obj Is Nothing Then
MsgBox "対象科目は存在しません。", _
vbOKOnly + vbInformation, "検索"
Else
'リストボックスをクリア
ListBox1.RowSource = ""
'検索にヒットした先頭のセルのアドレスをセット
wAddST = Obj.Address
'検索の繰り返し処理
Do
'検索にヒットしたセルのアドレスをセット
wAddress = Obj.Address
'検索にヒットしたセルの値を取得
wKamoku = .Range(wAddress).Value
'リストボックスに追加
ListBox1.AddItem wKamoku
'次の検索を行う
Set Obj = .Cells.FindNext(Obj)
'最初にヒットしたアドレスと同じ場合は処理を終了
If Obj.Address = wAddST Then Exit Do
Loop

End If

End With

End Sub

'検索リストボックス内のデータをダブルクリックするとシートのデータを選択します。

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim V As String
Dim rngFind As Range

V = Me.ListBox1.Value

With Worksheets("Sheet1").Range("A:A")
Set rngFind = .Find(what:=V, LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False, matchbyte:=False)
If Not rngFind Is Nothing Then
.Worksheet.Parent.Activate
.Worksheet.Activate
rngFind.Select
End If
End With

End Sub

No.4 ベストアンサー 回答者： ki-aaa 回答日時： 2016/06/01 14:36

ちょっとだけまずいところが有りましたので、修正します。

'検索用のテキストボックス更新後の処理
Private Sub TextBox1_AfterUpdate()
Dim Obj As Object
Dim wAddST As Variant
Dim wAddress As Variant
Dim wKamoku As Variant

With Worksheets("Sheet1")
'テキストボックスの値が含まれるセルを検索
Set Obj = .Range("A:A").Find(what:=TextBox1.Value, _
LookIn:=xlValues, _
lookat:=xlPart, _
matchbyte:=False)
'検索対象がない場合はメッセージを表示
If Obj Is Nothing Then
MsgBox "対象科目は存在しません。", _
vbOKOnly + vbInformation, "検索"
Else
'検索にヒットした先頭のセルのアドレスをセット
wAddST = Obj.Address
'リストボックスのList列数をセット
'ReDim ListBox1.List(0 To 0, 0 To 2)の替り
ListBox1.List = Range("A1:C1").Value
'リストボックスをクリア
ListBox1.Clear
'検索の繰り返し処理
Do
'検索にヒットしたセルの値を取得
'リストボックスに追加
ListBox1.AddItem Obj.Value
ListBox1.List(UBound(ListBox1.List), 1) = Obj.Offset(, 1).Value
ListBox1.List(UBound(ListBox1.List), 2) = Obj.Row

'次の検索を行う
Set Obj = .Range("A:A").FindNext(Obj)
'最初にヒットしたアドレスと同じ場合は処理を終了
If Obj.Address = wAddST Then Exit Do
Loop
End If
End With
End Sub


'検索リストボックス内のデータをダブルクリックするとシートのデータを選択します。
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Long
i = Me.ListBox1.ListIndex
Worksheets("Sheet1").Activate
On Error Resume Next
Cells(Me.ListBox1.List(i, 2), "A").Select
On Error GoTo 0
End Sub

この回答へのお礼

回答ありがとうございます。
あらためてこうしてコードを修正してもらうと、聞いてよかったと思いました。動作まったく問題ありませんでした。勉強します！
ありがとうございました。

お礼日時：2016/06/01 18:50

No.3 回答者： ki-aaa 回答日時： 2016/06/01 13:58

これでどうかな

RowSourceを使用しないで、List を使う。


Private Sub UserForm_Initialize()
Dim wLastGyou As Long

'最終行番号を取得
wLastGyou = Worksheets("Sheet1").UsedRange.Rows.Count
'リストボックスに「品目」のリストをセット
With ListBox1
.ColumnCount = 2
.ColumnWidths = "100;30"
'.ColumnHeads = True 'Listでは使用できない
'リストボックスの値にセルA2からA最終行までセット
.List = Sheets("Sheet1").Range("A2:B" & wLastGyou).Value
'.RowSource = "Sheet1!A2:B" & wLastGyou '使用しない
End With
End Sub


'検索用のテキストボックス更新後の処理
Private Sub TextBox1_AfterUpdate()
Dim Obj As Object
Dim wAddST As Variant
Dim wAddress As Variant
Dim wKamoku As Variant

With Worksheets("Sheet1")
'テキストボックスの値が含まれるセルを検索
Set Obj = .Cells.Find(what:=TextBox1.Value, _
LookIn:=xlValues, _
lookat:=xlPart, _
matchbyte:=False)
'検索対象がない場合はメッセージを表示
If Obj Is Nothing Then
MsgBox "対象科目は存在しません。", _
vbOKOnly + vbInformation, "検索"
Else
'検索にヒットした先頭のセルのアドレスをセット
wAddST = Obj.Address
'リストボックスのList列数をセット
'ReDim ListBox1.List(0 To 0, 0 To 2)の替り
ListBox1.List = Range("A1:C1").Value
'リストボックスをクリア
ListBox1.Clear
'検索の繰り返し処理
Do
'検索にヒットしたセルの値を取得
'リストボックスに追加
ListBox1.AddItem Obj.Value
ListBox1.List(UBound(ListBox1.List), 1) = Obj.Offset(, 1).Value
ListBox1.List(UBound(ListBox1.List), 2) = Obj.Row

'次の検索を行う
Set Obj = .Cells.FindNext(Obj)
'最初にヒットしたアドレスと同じ場合は処理を終了
If Obj.Address = wAddST Then Exit Do
Loop
End If
End With
End Sub


'検索リストボックス内のデータをダブルクリックするとシートのデータを選択します。
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Long
i = Me.ListBox1.ListIndex
If TextBox1.Text = "" Then Exit Sub

Worksheets("Sheet1").Activate
Cells(Me.ListBox1.List(i, 2), "A").Select
End Sub

No.2 回答者： くんこば 回答日時： 2016/05/31 21:48

ListBox1.AddItem wKamoku

これだと、１列目しか設定してないので表示されません。

他にも気になるところはありますが、質問の回答としては、ここを修正する必要がある、となります。
「コンボボックス、複数列、追加」で検索すれば、出てくると思いますよ。

この回答へのお礼

回答ありがとうございます。
検索していろいろ試行錯誤していましたが、自分のレベルでは理解不能でした…ただ、わかる人が見ればこれだけ指摘される修正箇所があるのにはビックリしました。
懲りずに勉強していきます。
ありがとうございました。

お礼日時：2016/06/01 18:46

No.1 回答者： くんこば 回答日時： 2016/05/31 21:42

まず、気になったとこWorksheets("Sheet1").UsedRange.Rows.Count

これだと行の数になるんで、ここは、
Worksheets("Sheet1").UsedRange.Row
でいいと思います。
BeforeUpdateは更新前処理です。AfterUpdateってイベントが更新後処理になります。