🔄
CrossSheetVLOOKUP
データ処理指定したシートのA列をキーにVLOOKUPを実行し結果を現在のシートB列に出力します
別シートのマスターデータを参照して、アクティブシートの指定列に対応する値を自動的に入力するマクロです。通常のVLOOKUP関数と異なり、参照元と参照先の設定をダイアログで対話的に指定できるため、関数の書き方を覚えていなくても使えます。顧客IDから顧客名を引く、商品コードから単価を取得するなど、シート間のデータ連携を自動化します。関数のコピーや絶対参照の設定ミスによるエラーも防止できます。VLOOKUP関数をセルに残す方式ではなく結果を値で書き込むため、マスターシートを後から削除・変更しても参照エラー（#REF!）が発生しません。関数入りのファイルは開くたびに再計算で重くなりがちですが、値貼り付け方式ならファイルも軽く保てます。照合前にTrimSpacesとNormalizeDataでキー列を整えておくと、「あるはずなのにN/Aになる」トラブルの大半を防げます。
📖 使い方
- VBAエディタを開く（Alt + F11）
- モジュールを挿入（挿入 > モジュール）
- 下記VBAコードをコピー&ペースト
- ブック上で実行（Alt + F8 でマクロ選択）
💡 実行例： A列にキー値があるシートでアクティブにしてから CrossSheetVLOOKUP を実行します
🎯 活用シーン
- ✓注文シートの顧客IDを元に、顧客マスターから氏名・住所・電話番号を自動入力したいとき
- ✓売上明細の商品コードから商品マスターを参照して商品名・単価・カテゴリを一括取得したいとき
- ✓社員番号リストから人事マスターデータを参照して部署名・役職・入社日を自動補完したいとき
- ✓毎月更新される価格マスターを参照して、見積シートの単価を一括更新したいとき
- ✓複数拠点から集めた売上データに、店舗コードから店舗名・エリア名を補完して分析用データを完成させたいとき
💡 実装のヒント
- ▸マスターデータシートの検索キー列は必ず一番左に配置してください。VLOOKUPの仕様上、検索キーが左端でないと正しく動作しません。
- ▸大量データを処理する場合は、マスターシートのデータをあらかじめ昇順ソートしておくと検索速度が向上します。
- ▸一致するデータが見つからない場合は「N/A」が表示されます。事前にマスターデータの整合性を確認しておくと作業がスムーズです。
- ▸結果が値として入るため、マスター側を更新した場合はマクロを再実行して最新の値を取り直してください。
- ▸N/Aが多発する場合は、キー列の全角半角・スペース混入を疑い、NormalizeDataで整えてから再実行すると解決することがほとんどです。
💻 VBAコード
' CrossSheetVLOOKUP
' -----------------
' Macro Name: CrossSheetVLOOKUP
' Description: 指定したシートのA列をキーにVLOOKUPを実行し結果を現在のシートB列に出力します
' Parameters: なし
' Returns: なし
' Usage: A列にキー値があるシートでアクティブにしてから CrossSheetVLOOKUP を実行します
' -----------------
Sub CrossSheetVLOOKUP()
On Error GoTo ErrorHandler
Dim destWs As Worksheet
Dim srcWs As Worksheet
Dim refSheetName As String
Dim colStr As String
Dim colNum As Long
Dim lastRow As Long
Dim refLastRow As Long
Dim i As Long
Dim lookupVal As Variant
Dim result As Variant
Dim refRange As Range
Dim foundCount As Long
Set destWs = ActiveSheet
refSheetName = InputBox("参照するシート名を入力してください", "参照シート")
If refSheetName = "" Then Exit Sub
On Error Resume Next
Set srcWs = Worksheets(refSheetName)
On Error GoTo ErrorHandler
If srcWs Is Nothing Then
MsgBox "シート「" & refSheetName & "」が見つかりません", vbCritical, "エラー"
Exit Sub
End If
colStr = InputBox("参照シートから取得する列番号を入力してください（例: 2）", "列番号", "2")
If colStr = "" Then Exit Sub
If Not IsNumeric(colStr) Then
MsgBox "数値を入力してください", vbCritical, "エラー"
Exit Sub
End If
colNum = CLng(colStr)
lastRow = destWs.Cells(destWs.Rows.Count, 1).End(xlUp).Row
If lastRow < 2 Then
MsgBox "現在のシートにデータが見つかりません", vbCritical, "エラー"
Exit Sub
End If
refLastRow = srcWs.Cells(srcWs.Rows.Count, 1).End(xlUp).Row
Set refRange = srcWs.Range("A1").Resize(refLastRow, colNum)
foundCount = 0
For i = 2 To lastRow
lookupVal = destWs.Cells(i, 1).Value
result = CVErr(xlErrNA)
On Error Resume Next
result = Application.WorksheetFunction.VLookup(lookupVal, refRange, colNum, False)
On Error GoTo ErrorHandler
If IsError(result) Or IsEmpty(result) Then
destWs.Cells(i, 2).Value = "N/A"
Else
destWs.Cells(i, 2).Value = result
foundCount = foundCount + 1
End If
Next i
MsgBox foundCount & " 件のデータを取得しました", vbInformation, "完了"
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました:" & vbCrLf & Err.Description, vbCritical, "エラー"
End Sub