氏名、住所、郵便番号、都道府県、電話番号、年齢をキーとした例です。
それぞれユーザーフォームにテキストボックスを追加しています。
'検索を実行します。部分一致検索を行っています。
Private Sub CommandButton1_Click()
Dim lastRow As Long
Dim myData, myData2(), myno
Dim i As Long, j As Long, cn As Long
Dim key1 As String, key2 As String, key3 As String, key4 As String, key5 As String, key6 As String
'氏名
If TextBox1.Value = "" Then key1 = "*" Else key1 = "*" & TextBox1.Value & "*"
'住所
If TextBox2.Value = "" Then key2 = "*" Else key2 = "*" & TextBox2.Value & "*"
'郵便番号
If TextBox3.Value = "" Then key3 = "*" Else key3 = "*" & TextBox3.Value & "*"
'都道府県
Dim ListNo As Long
ListNo = ComboBox1.ListIndex
If ListNo < 0 Then
key4 = "*"
Else
key4 = ComboBox1.List(ListNo)
End If
'電話番号
If TextBox4.Value = "" Then key5 = "*" Else key5 = "*" & TextBox4.Value & "*"
'年齢
If TextBox5.Value = "" Then key6 = "*" Else key6 = TextBox5.Value
'検索するデータを配列 myData に格納しています。
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
myData = .Range(.Cells(1, 1), .Cells(Rows.Count, 11).End(xlUp)).Value
End With
'配列 myData の中で検索で一致したデータを配列 myData2 に格納しています。
ReDim myData2(1 To lastRow, 1 To 7)
For i = LBound(myData) To UBound(myData)
If myData(i, 2) Like key1 And myData(i, 7) Like key2 And myData(i, 5) Like key3 And myData(i, 6) Like key4 And myData(i, 11) Like key5 And myData(i, 10) Like key6 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, 5) '郵便番号
myData2(cn, 5) = myData(i, 7) '住所
myData2(cn, 6) = myData(i, 11) '電話番号
myData2(cn, 7) = myData(i, 10) '年齢
End If
Next i
'検索で一致したデータをリストボックスに表示します。
With ListBox1
.ColumnCount = 7
.ColumnWidths = "20;70;70;30;150;70;30"
.List = myData2
End With
End Sub
'検索を実行します。部分一致検索を行っています。 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
何回か書き直しています。m(__)m
こちらでコードを書いて試してみた結果、下のような感じでどうにか行けそうな気がしました。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_listbox.html
の一番下に追記していますので、参照するとわかりやすいと思います。
都道府県名が"Sheet1!O2:O48"に入力されていて、コンボボックスに
初期設定Private Sub UserForm_Initialize() で
With ComboBox1
.RowSource = "Sheet1!O2:O48"
End With
のように書いていあるときの例です。
すると、下のコードのようにして検索が可能と考えました。
なお、このコードは
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_listbox.html
のデータで検索するものです。
Private Sub CommandButton1_Click()
Dim lastRow As Long
Dim myData, myData2(), myno
Dim i As Long, j As Long, cn As Long
Dim key1 As String, key2 As String, key3 As String, key4 As String
If TextBox1.Value = "" Then key1 = "*" Else key1 = "*" & TextBox1.Value & "*"
If TextBox2.Value = "" Then key2 = "*" Else key2 = "*" & TextBox2.Value & "*"
If TextBox3.Value = "" Then key3 = "*" Else key3 = "*" & TextBox3.Value & "*"
Dim ListNo As Long
ListNo = ComboBox1.ListIndex
If ListNo < 0 Then
key4 = "*"
Else
key4 = ComboBox1.List(ListNo)
End If
With Worksheets("Sheet1")
myData = .Range(.Cells(1, 1), .Cells(Rows.Count, 7).End(xlUp)).Value
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
End With
ReDim myData2(1 To lastRow, 1 To 3)
For i = LBound(myData) To UBound(myData)
' If myData(i, 2) Like "*" & TextBox1.Value & "*" And myData(i, 7) Like "*" & TextBox2.Value & "*" Then
If myData(i, 2) Like key1 And myData(i, 7) Like key2 And myData(i, 5) Like key3 And myData(i, 6) Like key4 Then
cn = cn + 1
myData2(cn, 1) = myData(i, 1)
myData2(cn, 2) = myData(i, 2)
myData2(cn, 3) = myData(i, 7)
End If
Next i
With ListBox1
.ColumnCount = 3
.ColumnWidths = "30;70;70"
.List = myData2
End With
End Sub
'検索を実行します。部分一致検索を行っています。 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 = "30;70;70;100;100" .List = myData2 End With