【エクセルVBA】ChangeイベントとEnableEventsプロパティで部分一致検索をする方法

皆様こんにちは、ノグチです。

請求書や発注書、見積書を作るときに、得意先や仕入先の正式名称を入力することがありますよね。

先方から頂いた帳票にある社名を見ながらタイピングしていても、漢字を間違えてしまっていたり、省略してしまっていたり…

セルに名称の一部を入力したら正式名称に変換してくれるような機能は無いものか…

それ、ひょっとするとWorksheetオブジェクトのChangeイベントを使うと実現できるかもしれません。

Changeイベントとは？やイベントプロシージャの準備は前回記事でご紹介していますので、併せてご覧ください。

【エクセルVBA】イベントを使ってもっと便利なツールにしてみよう！WorksheetオブジェクトのChangeイベント

エクセルのイベント、WorksheetオブジェクトのChangeイベントをご紹介しています。シートに対して、セルの入力や削除などがあった時の処理をこのイベントに仕込んでおけば、変更のアクション終了と同時に処理が実行されて便利ですよ！

Changeイベントで入力した値から部分一致で得意先名を取得する
Changeイベントによって無限ループになる！
Application.EnableEventsで一時的にイベントのON/OFFを切り替える
1. Application.EnableEventsはセットでコードに加える
2. 動作確認
最後に
連載目次：エクセルVBAのイベントを使ってもっと便利なツールにしよう！

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プロパティを使います。

Application.EnableEvents = True(又はFalse)

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イベントが実行されなくなってしまいますからね。