みなさまこんにちは、ノグチです。
前回は、エクセルの入力規則のひとつ、ドロップダウンリストをVBAで設定する方法をご紹介しました。
今回は、前回のドロップダウンリストの作成と、前々回のChangeイベントを使った文字の一部検索を組み合わせて、セルに入力した値を部分検索して、ヒットした検索結果を全て入力セルのドロップダウンリストに表示させる方法をご紹介していきます！
エクセルVBAでドロップダウンリストを作る方法については前回の記事を、
Changeイベントを使った部分一致検索は前々回の記事をご覧ください。
Changeイベントプロシージャに入力規則作成を差し込む
前回コードのおさらい
では、早速コードを書いていきましょう。
まず、前々回記事でご紹介したコードがこちら。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCustom As Object
Dim myRange As Range
With Worksheets("マスタ")
Set myRange = .Range("A1:A6")
End With
With ActiveSheet
If Target = .Range("B5") Then
On Error Resume Next
Set objCustom = myRange.Find(what:=Target.Value, LookAt:=xlPart)
Application.EnableEvents = False
If objCustom Is Nothing Then
Target.Value = Target.Value
Else
Target.Value = objCustom
End If
Application.EnableEvents = True
End If
End With
End Sub
そして入力シートと、マスタシートがこちらです。
入力シートのB5セルに入力した値から、マスタシートにある得意先の正式名称を取得、入力セルに返す、という処理をするコードでした。
入力規則作成処理を差し込む
ここに前回ご紹介した、セル範囲にドロップダウンリストを作成するコードを差し込みます。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCustom As Object
Dim myRange As Range
'マスタリストの範囲をセット
Set myRange = Worksheets("マスタ").Range("A1:A6")
With ActiveSheet
If Target = .Range("B5") Then
On Error Resume Next
Set objCustom = myRange.Find(what:=Target.Value, LookAt:=xlPart)
Application.EnableEvents = False
If objCustom Is Nothing Then
Target.Value = Target.Value
Else
With Target.Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertInformation, _
Formula1:=varList
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
Findメソッドを使ってB5セルの入力値で、スタシートの得意先名称を検索した時の処理に、検索にヒットした場合にValidation.AddメソッドでB5セルにドロップダウンリストを作成する、というコードを差し込んでいます。
これでFindメソッドにマッチした得意先の正式名称がマスタシートから取得されて、このようにドロップダウンリストに表示されるようになります。
複数の検索結果をドロップダウンリストに表示させる
しかし、マスタシートを見てみると、検索に使った文字列『会社』を含む得意先は全部で4つあります。
なのに、上の画像では1件しか取得できていません。
どうせならヒットした値はすべてドロップダウンリストに表示させたいですよね。
なので、検索に使う文字列を含む得意先をすべてドロップダウンリストに表示できるように、もう少しコードに手を加えましょう。
Findメソッドでマスタシートを検索して、マッチしたセル以降のセルはFindNextメソッドを使って値を検索します。
そしてマッチする値があったら、Validation.AddメソッドのFomula1パラメータセット用の変数varListに格納していく、という処理を加えます。
こんな感じで。
If objCustom Is Nothing Then Target.Value = Target.Value Else '1件目を文字列にセット varList = objCustom strAdr = objCustom.Address Do Set objCustom = myRange.FindNext(objCustom) If objCustom Is Nothing Then Exit Do Else If strAdr <> objCustom.Address Then varList = varList & "," & objCustom End If End If Loop While Not objCustom Is Nothing And objCustom.Address <> strAdr End If
ShowErrorプロパティでエラーメッセージを表示させないようにする
1度セルに検索したい値を入力して、Changeイベントが実行された後にもう一度違う値で検索をしたい！という場合もありますよね。
その場合、上のコードのValidation.Addメソッドのパラメータ指定では、B5セルにドロップダウンリストに表示されていない値を入力すると、毎回メッセージが表示されてしまいます。
少々煩わしいので、このメッセージ表示をOFFにしてしまいましょう。
これには、ValidationオブジェクトのShowErrorプロパティを使います。
ShowErrorプロパティは、このように記述します。
入力規則に指定された値以外を入力した時に表示されるメッセージを表示させたい場合をTrueを、表示させたくない場合はFalseを指定します。
これも、上のコードに差し込んでおきましょう。
複数の検索結果をドロップダウンリストに表示させるコード
すると、こんなコードになります。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCustom As Object
Dim myRange As Range 'マスタのセル範囲
Dim varList As Variant 'プロパティFormula1の文字列作成用
Dim strAdr As String '最初にヒットしたセル
'マスタリストの範囲をセット
Set myRange = Worksheets("マスタ").Range("A1:A6")
With ActiveSheet
If Target = .Range("B5") Then
On Error Resume Next
Set objCustom = myRange.Find(what:=Target.Value, LookAt:=xlPart)
Application.EnableEvents = False
If objCustom Is Nothing Then
Target.Value = Target.Value
Else
'1件目を文字列にセット
varList = objCustom
strAdr = objCustom.Address
Do
Set objCustom = myRange.FindNext(objCustom)
If objCustom Is Nothing Then
Exit Do
Else
If strAdr <> objCustom.Address Then
varList = varList & "," & objCustom
End If
End If
Loop While Not objCustom Is Nothing And objCustom.Address <> strAdr
With Target.Validation
.Delete
.Add Type:=xlValidateList, _
Formula1:=varList
.ShowError = False
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
ちなみに、最初のFindメソッドにマッチする値があった場合、strAdr = objCustom.Addressで、マッチした値のセルを取得していますね。
これは、次のDo~Loopにある、FindNextメソッドの終了条件のために取得しています。
上のコードの場合、FindNextメソッドはマスタシートの最後のセルまで検索したら、もう一度得意先リストの先頭から検索を始めようとします。
1件目の得意先名はDo~Loopの前のFindメソッドで検索されていて、すでにFormula1パラメータ用の変数に格納されているので、それ以上検索を続ける必要はありません。
そこで、最初のFindメソッドにマッチした値を持つセルのアドレスを取得しておいて、Do~Loopの終了条件に『1件目にヒットしたセルではないこと』を加えて、
Loop While Not objCustom Is Nothing And objCustom.Address <> strAdr
このように記述しておく必要があります。
動作確認
では、さっそくこちらを動かしてみましょう！
B5セルに『会社』と入力してエンターキーを押すと…
この通り、ドロップダウンリストに検索にヒットした得意先名がすべて表示されていますね！
最後に
今回は、Changeイベントと入力規則のドロップダウンリストを組み合わせて、検索値にヒットする文字列をすべてドロップダウンリストに表示する方法をご紹介しました。
Changeイベントをうまく使えば、もしかしたら普段使っているエクセルツールをもっと便利なツールにできるかもしれませんね。
次回記事では、Findメソッドの使い方をご紹介していますので、今回の記事と併せてご覧ください。
それでは、最後までお読みいただきありがとうございました！
連載目次：エクセルVBAのイベントを使ってもっと便利なツールにしよう！
エクセルVBAでリストの重複を排除する方法として、Dictionaryオブジェクトを使った重複排除の方法をご紹介しています。
