Sub TEST1()
'抽出リストをクリア
Sheets("検索").Range("F2:F1000").Clear
j = 1
For i = 2 To Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Row
'部分一致で検索
If InStr(Sheets("DB").Cells(i, "A"), Sheets("検索").Range("B3")) > 0 Then
j = j + 1
'「商品」を抽出
Sheets("検索").Cells(j, "F") = Sheets("DB").Cells(i, "A")
End If
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "B3" Then
Call TEST1 '部分一致で、「商品」を抽出
End If
End Sub
絞りこむ値を入力してみます。
絞りこむ値を入力
入力したタイミングで、データベースから値を部分一致することができます。
入力したタイミングで値を抽出できる
入力したタイミングで、データベースから値を部分一致することができました。
値を検索する
選択した検索値を、データベースから検索するVBAコードです。
Sub TEST2()
For i = 2 To Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Row
'検索する「商品」と一致するかを確認
If Sheets("DB").Cells(i, "A") = Sheets("検索").Range("D3") Then
Sheets("検索").Range("B5") = Sheets("DB").Cells(i, "B") '価格
Sheets("検索").Range("B6") = Sheets("DB").Cells(i, "C") '残り数量
Sheets("検索").Range("B7") = Sheets("DB").Cells(i, "D") '必要数量
Sheets("検索").Range("A9") = Sheets("DB").Cells(i, "E") '備考
End If
Next
End Sub
検索する値をプルダウンリストから選択しておきます。
検索値を選択
実行すると、データベースから値を検索できます。
値を検索できる
データベースから値を検索できました。
Changeイベントを作成
Changeイベントを作成して、検索値を選択したタイミングで、値を検索できるようにします。
先ほどと同じように、「検索」シートの「シートモジュール」に記載をします。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "B3" Then
Call TEST1 '部分一致で、「商品」を抽出
End If
If Target.Address(False, False) = "D3" Then
Call TEST2 '「商品」を検索
End If
End Sub
