皆様こんにちは、ノグチです。
請求書や発注書、見積書を作るときに、得意先や仕入先の正式名称を入力することがありますよね。
先方から頂いた帳票にある社名を見ながらタイピングしていても、漢字を間違えてしまっていたり、省略してしまっていたり…
セルに名称の一部を入力したら正式名称に変換してくれるような機能は無いものか…
それ、ひょっとするとWorksheetオブジェクトのChangeイベントを使うと実現できるかもしれません。
Changeイベントとは？やイベントプロシージャの準備は前回記事でご紹介していますので、併せてご覧ください。
Changeイベントで入力した値から部分一致で得意先名を取得する
たとえば、こんな請求書ファイルがあるとします。
1シート目は請求書のテンプレート、2シート目は得意先の正式名称をリストにしたマスタシートになっています。
請求書のB5セルに得意先名の一部を入力したら、同じブック内にあるマスタシートの得意先リストを部分一致検索して、ヒットしたら得意先の正式名称をB5セルに返したい…
この処理のコードを、Changeイベントプロシージャに単純に書いてみると、こんな感じになります。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCustom As Object
Dim myRange As Range
With Worksheets("マスタ")
Set myRange = .Range("A1:A5")
End With
With ActiveSheet
If Target = .Range("B5") Then
On Error Resume Next
Set objCustom = myRange.Find(what:=Target.Value, LookAt:=xlPart)
If objCustom Is Nothing Then
Target.Value = Target.Value
Else
Target.Value = objCustom
End If
End If
End With
End Sub
B5セルに得意先の正式名称の一部を入力すると、マスタシートのA列ある得意先リストから正式名称を検索して、正式名称をB5セルに返してくれる、というコードですね。
Changeイベントによって無限ループになる！
しかしここで問題が一つ。
実際にこのコードを実行していただければわかるのですが、このコード、このままだとB5セルに値を入力してセルからフォーカスが外れた瞬間、無限ループに陥ります。
なぜか。
それは、このChangeイベントのトリガーに起因しています。
Changeイベントが実行されるトリガーを思い出してみましょう。
オブジェクトモジュールであるシート内容に変更が加えられたこと、ですね。
上のコードではB5セルに入力された値をもとに、マスタシートから得意先の正式名称を検索して、B5セルに値を出力しています。
そう、マクロでセルに値を出力することも、Changeイベントにとっては「シートの変更」とみなされるのです。
実際にコードにブレークポイントを置いてデバッグしてみると…
処理は、B5セルに値を出力すると次のステップにあるEnd Ifに行かずに、イベントプロシージャの先頭に行ってしまうのです！
このまま処理を続けても、またB5セルに値を出力して、イベントプロシージャの先頭に戻って、またB5セルに値を出力して、先頭に戻って…と、魔の無限ループに陥ってしまうのです！
これではツールとして使えません。
一体どうすればいいのか。
ご安心あれ。
単純に、イベントを一時的に実行させないようにしてあげればよいのです。
Application.EnableEventsで一時的にイベントのON/OFFを切り替える
イベントの実行を一時的にON/OFFするには、ApplicationオブジェクトのEnableEventsプロパティを使います。
EnableEventsプロパティにTrueを指定すると、イベントの実行が有効になり、Falseを指定すると無効になる、ということですね。
このプロパティを使って、一時的にイベントの実行を無効にしてあげれば、上のコード内でセルに値を出力しても(シートに変更を加えても)、無限ループに陥ることを防げるのです。
Application.EnableEventsはセットでコードに加える
このEnableEventsプロパティをコードに加えると、こんな感じのコードになります。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objCustom As Object
Dim myRange As Range
With Worksheets("マスタ")
Set myRange = .Range("A1:A5")
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
ポイントとして、セルに値を出力する前にApplication.EnableEvents = Falseで一時的にイベントの実行を無効にして、セルに値を出力し終えたところでApplication.EnableEvents = Trueでイベントの実行をもう一度有効にしておきましょう。
Application.EnableEvents = Trueを忘れてしまうと、もう一度シートへに変更があってもChangeイベントが実行されなくなってしまいますからね。
動作確認
では、上のコードを実際に動かしてみましょう。
B5セルに、得意先名の一部を入力して…
エンターキーを押すと、
この通り、マスタシートから得意先の正式名称を持ってきてくれました！
Application.EnableEvents = Falseで一時的にイベント実行を無効にしているので、無限ループに陥ることもありません！
最後に
今回は、WorksheetオブジェクトのChangeイベントと、ApplicationオブジェクトのEnableEventsプロパティを使って、セルに入力された値から、部分一致検索によって得意先の正式名称をマスタから取得する方法をご紹介しました。
マスタシートの構成や部分一致検索する部分のコードを工夫すれば、ふり仮名や電話番号などでも検索することができそうですね。
それでは、最後までお読みいただきありがとうございました！
次回記事では、今回のようにchangeイベントを使って検索した値をドロップダウンリストで表示する方法の第一歩として、VBAで入力規則のドロップダウンリストを作る方法をご紹介しています。
連載目次：エクセルVBAのイベントを使ってもっと便利なツールにしよう！
エクセルVBAでリストの重複を排除する方法として、Dictionaryオブジェクトを使った重複排除の方法をご紹介しています。
