検索結果をリストボックスに表示する:Excel VBA入門

データ内を検索して一致したデータをリストボックスに表示する例です。

スポンサードリンク

はじめに　　　Topへ

住所録のデータがあり、これから名前の一部または住所の一部が一致するデータを検索して、リストボックスに表示します。
検索するデータの例
ここで作成するコードに必要なフィールドはA列の連番、B列の氏名、G列の住所の3つです。ほかのフィールドはここでのコードでは利用していません。
作成したユーザーフォーム
検索したい氏名を入力する TextBox1、検索したい住所を入力する TextBox2、検索を実行する CommandButton1を配置しています。
検索結果を表示するのは下の ListBox1　になります。
検索を実行後のユーザーフォームの例
氏名に「田」を含み、住所に「東京」が含まれるデータがリストボックスに表示されています。

作成したコード

標準モジュールにユーザーフォームを表示するコードを書いています。

Sub test()
　　UserForm1.show
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 TextBox2.Value = "" Then End

　　'検索するデータを配列　myData　に格納しています。
　　With Worksheets("Sheet1")
　　　　　'---　2018/9/27修正しました
　　　　 lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
　　　　myData = .Range(.Cells(1, 1), .Cells(lastRow, 7)).Value
　　End With

　　'配列　myData の中で検索で一致したデータを配列　myData2　に格納しています。
　　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
　　　　　　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 ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
　　With Worksheets("Sheet1")
　　　　.Range(.Cells(ListBox1.List(ListBox1.ListIndex, 0) + 1, 1), .Cells(ListBox1.List(ListBox1.ListIndex, 0) + 1, 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")
　　　　　'---　2018/9/27修正しました
　　　　 lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
　　　　myData = .Range(.Cells(1, 1), .Cells(lastRow, 7)).Value
　　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, 7)
　　Next i

　　With ListBox1
　　　　.ColumnCount = 3
　　　　.ColumnWidths = "30;70;70"
　　　　.List = myData2
　　End With
End Sub

別のファイルのシートを検索する例

掲示板で別ファイルを検索したいとの質問がありました。(2018/4/17)
ここでは検索を実行するファイルから検索するデータのあるファイル　kensaku.xlsm　を開いて、データリストのあるシート meibo を検索します。
実行画面は下図のようになります。
下図はあらかじめ検索するデータのあるファイルを開いてからVBAを実行しています。
左のファイルの[検索]ボタンをクリックして、VBAを実行しています。
ユーザーフォームで　氏名　「山」、住所　「鹿児島」を含むデータを[検索]してリストボックスに表示しました。
リストの中山さんをダブルクリックして、別ファイルの中山さんの行を選択できました。

コードはファイルを開く部分と検索するデータのあるシートの指定方法を書き換えています。赤文字の部分です。

'検索を実行します。部分一致検索を行っています。
Private Sub CommandButton1_Click()
　　Dim lastRow As Long
　　Dim myData, myData2(), myno
　　Dim i As Long, j As Long, cn As Long

　　Dim myBook As Workbook
　　Set myBook = Workbooks("kensaku.xlsm")

　　'検索するデータを配列　myData　に格納しています。
　　　　With myBook.Worksheets("meibo")
　　　　　'---　2018/9/27修正しました
　　　　 lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
　　　　myData = .Range(.Cells(1, 1), .Cells(lastRow, 7)).Value
　　End With

　　'配列　myData の中で検索で一致したデータを配列　myData2　に格納しています。
　　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
　　　　　　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 ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
　　 Dim myBook As Workbook
　　Set myBook = Workbooks("kensaku.xlsm")

　　With myBook.Worksheets("meibo")
　　　　.Activate　'別ファイルのシートをアクティブにします。
　　　　.Range(.Cells(ListBox1.List(ListBox1.ListIndex, 0) + 1, 1), .Cells(ListBox1.List(ListBox1.ListIndex, 0) + 1, 13)).Select
　　End With
End Sub

'----------------------------------------------
'ユーザーフォームの初期設定：リストの全データを表示しています。
Private Sub UserForm_Initialize()
　　Dim lastRow As Long
　　Dim myData, myData2()
　　Dim i As Long, j As Long

　　Dim myBook As Workbook
　　Set myBook = Workbooks.Open("c:\users\yone4\Documents\old_mydoc\HP用データファイル\HP_2010\kensaku.xlsm")
’---あらかじめファイルを開いている場合は↓を使う。ファイルを開く場合は上の行↑を使う
　　' Set myBook = Workbooks("kensaku.xlsm")　

　　With myBook.Worksheets("meibo")
　　　　　　'---　2018/9/27修正しました
　　　　 lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
　　　　myData = .Range(.Cells(1, 1), .Cells(lastRow, 7)).Value
　　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, 7)
　　Next i

　　With ListBox1
　　　　.ColumnCount = 3
　　　　.ColumnWidths = "30;70;70"
　　　　.List = myData2
　　End With
End Sub

コンボボックスを追加して県名でも検索する

掲示板で検索キーワードを増やしたいとの質問がありました。(2018/9/21)
コンボボックスで都道府県名を検索キーワードにしたいとのことです。
ユーザーフォームにコンボボックスを追加しています。
都道府県はシートのO2:O48に入力しておき、ユーザーフォームの表示時にコンボボックスに読み込むようにしています。
ユーザーフォームのコンボボックスで「鹿児島県」の行を選択して、[検索]ボタンで検索結果をリストボックスに表示して例です。

コードは下記のように変更しました。

ほかにも不具合が発見されましたので、修正します。（2018/9/26）
最終行を求めている部分が異なる列で求めていましたので、同じ列で最終行を求めるように修正しました。
具体的には、myData = .Range(.Cells(1, 1), .Cells(Rows.Count, 7).End(xlUp)).Value　と　lastRow = .Cells(Rows.Count, 7).End(xlUp).Rowの列を同じにしました。

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")
　　　　　'---　2018/9/27修正しました
　　　　 lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
　　　　myData = .Range(.Cells(1, 1), .Cells(lastRow, 7)).Value
　　End With

　　ReDim myData2(1 To lastRow, 1 To 3)
　　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 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 ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
　　With Worksheets("Sheet1")
　　.Range(.Cells(ListBox1.List(ListBox1.ListIndex, 0) + 1, 1), .Cells(ListBox1.List(ListBox1.ListIndex, 0) + 1, 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")
　　　　　'---　2018/9/27修正しました
　　　　 lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
　　　　myData = .Range(.Cells(1, 1), .Cells(lastRow, 7)).Value
　　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, 7)
　　Next i

　　With ListBox1
　　　　.ColumnCount = 3
　　　　.ColumnWidths = "30;70;70"
　　　　.List = myData2
　　End With

　　With ComboBox1
　　　　.RowSource = "Sheet1!O2:O48"
　　End With

End Sub

'---------
Private Sub CommandButton2_Click()
　　UserForm_Initialize
End Sub

スポンサードリンク

よねさんのWordとExcelの小部屋｜Excel(エクセル)講座の総目次｜Excel(エクセル) VBA入門：目次｜検索結果をリストボックスに表示する

PageViewCounter
　 Counter
　Since2006/2/27

検索結果をリストボックスに表示する:Excel VBA入門

はじめに Topへ

作成したコード

別のファイルのシートを検索する例

コンボボックスを追加して県名でも検索する

はじめに　　　Topへ