| ご返信ありがとうございました。 再度ではありますが、アドバイスをお願い致します。
下記の様にして、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
|