https://www.limecode.jp/entry/fungo/054-worksheet-change

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題：◆

#VBA100本ノック 54本目
イベントを使い、商品コードを入れたら「マスタ」から取得した商品名と単価が直ちに表示されるようにしてください。
商品コードがマスタに存在しない場合は商品コードを赤字にしてください。
※金額はセルに計算式が入っています。
※商品コード列の既定の文字色は「自動」

マスタ自動参照シート

◇ 出題ページはこちら

ソースコード

定義モジュール

Option Explicit

' 伝票
Public Const R1st伝票 = 2
Public Const C1st伝票 = 1
Public Enum CNo伝票
    No = C1st伝票
    商品コード
    商品名
    数量
    単価
    金額
End Enum
Public Const CLast伝票 = CNo伝票.金額

' マスタ
Public Const R1stマスタ = 2
Public Const C1stマスタ = 1
Public Enum CNoマスタ
    商品コード = C1stマスタ
    商品名
    単価
End Enum
Public Const CLastマスタ = CNoマスタ.単価

シートモジュール(WS伝票)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    ' 変更されたUsedRange内の商品コード列を取得
    Dim 商品コード変更セル範囲 As Range: Set 商品コード変更セル範囲 _
        = Intersect(Target, Columns(CNo伝票.商品コード) _
                    , GetUsedRange指定行以下(Me, R1st伝票))

    If 商品コード変更セル範囲 Is Nothing Then Exit Sub

    Application.EnableEvents = False
    
    ' 各変更セルをループ
    Dim 変更セル As Range, i As Long
    For Each 変更セル In 商品コード変更セル範囲
        Dim R_伝票 As Long: R_伝票 = 変更セル.Row

        ' 商品コードをマスタから検索
        Dim R_マスタ As Long
        R_マスタ = Match行番号(変更セル.Value _
            , WSマスタ.Columns(CNoマスタ.商品コード))

        ' マスタ登録なし
        If R_マスタ = 0 Then
            変更セル.Font.Color = IIf(変更セル = "", xlAutomatic, vbRed)
            WS伝票.Cells(R_伝票, CNo伝票.商品名) = ""
            WS伝票.Cells(R_伝票, CNo伝票.単価) = ""
        
        ' マスタ登録あり
        Else
            変更セル.Font.ColorIndex = xlAutomatic
            WS伝票.Cells(R_伝票, CNo伝票.商品名) = WSマスタ.Cells(R_マスタ, CNoマスタ.商品名)
            WS伝票.Cells(R_伝票, CNo伝票.単価) = WSマスタ.Cells(R_マスタ, CNoマスタ.単価)
            
        End If
    Next
    
    Application.EnableEvents = True
End Sub

汎用関数モジュール

Option Explicit

' WorksheetFunctionの短縮取得
' 参考：https://www.limecode.jp/entry/utility/shortcall-worksheetfunction
Function Fx() As WorksheetFunction
    Set Fx = WorksheetFunction
End Function

' 行番号の検索
' ◆ ブログ未掲載
Function Match行番号(ByVal 検索値 As Variant, 検索エリア As Range) As Long
    On Error Resume Next
    If IsDate(検索値) Then
        Dim x: x = CDbl(検索値)
        If Err.Number = 0 Then
            Match行番号 = Fx.Match(CDbl(検索値), 検索エリア, 0) + 検索エリア.Row - 1
            Exit Function
        End If
    End If

    Match行番号 = Fx.Match(検索値, 検索エリア, 0) + 検索エリア.Row - 1

End Function

' UsedRangeのカット
Function GetUsedRange指定行以下(対象シート As Worksheet, 指定行 As Long) As Range
    With 対象シート
        Set GetUsedRange指定行以下 = Intersect(.UsedRange, .Rows(指定行).Resize(.UsedRange.Rows.Count))
    End With
End Function