| ご返信ありがとうございました。
再度ではありますが、アドバイスをお願い致します。
下記の様にして、sheet1の3行目に入力されているリストから出るようにしてみました。
その際に検索画面でコンビボックスやテキストボックスを空欄にして検索すると、「インデックスが有効範囲にありません。」と表示されてしまいます。
回避方法はどのようにしたらよろしいでしょうか？
--------------------以下入力内容-----------------------------
'検索を実行します。部分一致検索を行っています。
Private Sub CommandButton1_Click()
Dim lastRow As Long
Dim myData, myData2(), myno
Dim i As Long, j As Long, cn As Long
' If TextBox1.Value = "" Or cmb区分.Value = "" or TextBox3.Value = "" Then End
'検索するデータを配列 myData に格納しています。
With Worksheets("Sheet1")
myData = .Range(.Cells(1, 1), .Cells(Rows.Count, 6).End(xlUp)).Value
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
End With
'配列 myData の中で検索で一致したデータを配列 myData2 に格納しています。
ReDim myData2(1 To lastRow, 1 To 5)
For i = LBound(myData) To UBound(myData)
If myData(i, 2) Like "*" & TextBox1.Value & "*" And myData(i, 3) Like "*" & cmb区分.Value & "*" And myData(i, 4) Like "*" & TextBox3.Value & "*" Then
cn = cn + 1
myData2(cn, 1) = myData(i, 1)
myData2(cn, 2) = myData(i, 2)
myData2(cn, 3) = myData(i, 3)
myData2(cn, 4) = myData(i, 4)
myData2(cn, 5) = myData(i, 5)
End If
Next i
'検索で一致したデータをリストボックスに表示します。
With ListBox1
.ColumnCount = 5
.ColumnWidths = "10;30;70;60;400"
.List = myData2
End With
End Sub
'----------------------------------------------
'リストボックス内のデータをダブルクリックするとシートのデータを選択します。
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
With Worksheets("Sheet1")
.Range(.Cells(ListBox1.List(ListBox1.ListIndex, 0) + 2, 1), .Cells(ListBox1.List(ListBox1.ListIndex, 0) + 2, 13)).Select
End With
End Sub
'----------------------------------------------
'ユーザーフォームの初期設定：リストの全データを表示しています。
Private Sub UserForm_Initialize()
Dim lastRow As Long
Dim myData, myData2()
Dim i As Long, j As Long
With Worksheets("Sheet1")
myData = .Range(.Cells(1, 1), .Cells(Rows.Count, 6).End(xlUp)).Value
lastRow = .Cells(Rows.Count, 2).End(xlUp).Row
End With
ReDim myData2(1 To lastRow, 1 To 3)
For i = LBound(myData) To UBound(myData)
myData2(i, 1) = myData(i, 1)
myData2(i, 2) = myData(i, 2)
myData2(i, 3) = myData(i, 3)
Next i
With ListBox1
.ColumnCount = 3
.ColumnWidths = "30;70;70"
.List = myData2
End With
'ボックスリスト
cmb区分.List = MakeUniqueList
cmb区分.ListIndex = 1
End Sub
Function MakeUniqueList()
Dim objDic As Object 'New Scripting.Dictionary
Dim i As Long, j As Long
j = 1
Set objDic = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet1")
'2行目から
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If Not objDic.Exists(.Cells(i, 3).Value) Then
objDic.Add .Cells(i, 3).Value, j
j = j + 1
End If
Next
End With
MakeUniqueList = objDic.keys
End Function
|
Excel(エクセル) VBA入門：検索結果をリ�..
/ なお Mail (18/09/19(Wed) 12:52) #13296 
上記ツリーを一括表示 / 上記ツリーをトピック表示