Excel VBA 逆引き集 | 右外部結合

Excel VBA
スポンサーリンク

右外部結合

「相手表のキーを“全部”残しつつ、基準表の情報を横付けしたい（基準に無ければ空欄や0で補完）」——それが右外部結合です。左外部結合の“逆”なので、相手表を基準にして結合します。最短の関数版、爆速の辞書版、見出し名対応、安全な複数キーまで、初心者でも壊れないテンプレを用意しました。

使い分けの指針

  • 最短・少量: 相手表を基準に VLOOKUP（式投入→値化）
  • 列増減に強い: INDEX/MATCH（列番号不要）
  • 大量・高速: 配列＋辞書で右外部結合（相手表の全キーを出力）
  • 列順が不安: 見出し名から列特定して安全に参照
  • 複数キー: ヘルパー列でキー連結（例：部署|年月）

最短：相手表を基準に VLOOKUP（右外部結合の考え方）

「右外部結合＝相手表が“基準”」。相手表のキー全件を出し、基準表から該当があれば値を引きます。

Sub RightJoin_VLookup()
    '基準: Sheet("基準") A=コード, B=名称, C=合計
    '相手: Sheet("相手") A=コード, B=他合計
    '出力: Sheet("右外部結合") … 相手表の全コードを軸に基準を横付け

    Dim wsB As Worksheet: Set wsB = Worksheets("基準")
    Dim wsO As Worksheet: Set wsO = Worksheets("相手")
    Dim wsOut As Worksheet
    On Error Resume Next
    Set wsOut = Worksheets("右外部結合")
    If wsOut Is Nothing Then Set wsOut = Worksheets.Add: wsOut.Name = "右外部結合"
    On Error GoTo 0

    Dim rgB As Range: Set rgB = wsB.Range("A1").CurrentRegion       '基準表（A:C）
    Dim rgO As Range: Set rgO = wsO.Range("A1").CurrentRegion       '相手表（A:B）

    wsOut.Cells.Clear
    wsOut.Range("A1:D1").Value = Array("コード", "他合計", "名称", "合計")

    Dim lastO As Long: lastO = rgO.Rows.Count
    '相手表のキー・他合計を先にコピー（右外部の“右”は相手）
    wsOut.Range("A2").Resize(lastO - 1, rgO.Columns.Count).Value = rgO.Offset(1).Resize(lastO - 1).Value

    '基準から名称・合計をVLOOKUPで付与 → 値化
    With wsOut.Range("C2:C" & lastO)
        .FormulaR1C1 = "=IFERROR(VLOOKUP(RC1," & rgB.Address(True, True, xlA1, True) & ",2,FALSE),"""")"
        .Value = .Value
    End With
    With wsOut.Range("D2:D" & lastO)
        .FormulaR1C1 = "=IFERROR(VLOOKUP(RC1," & rgB.Address(True, True, xlA1, True) & ",3,FALSE),0)"
        .Value = .Value
    End With

    wsOut.Columns.AutoFit
End Sub
VB
  • ポイント
    • 相手表全件を「土台」にしてから、基準表の値を引くのが右外部結合。
    • 欠損補完は空欄や0に。式は必ず値化して軽く・安定運用。

列増減に強い：INDEX/MATCHで右外部結合（相手表基準）

Sub RightJoin_IndexMatch()
    Dim wsB As Worksheet: Set wsB = Worksheets("基準") 'A=コード, B=名称, C=合計
    Dim wsO As Worksheet: Set wsO = Worksheets("相手") 'A=コード, B=他合計
    Dim wsOut As Worksheet
    On Error Resume Next
    Set wsOut = Worksheets("右外部結合")
    If wsOut Is Nothing Then Set wsOut = Worksheets.Add: wsOut.Name = "右外部結合"
    On Error GoTo 0

    Dim rngKeyB As Range: Set rngKeyB = wsB.Range("A:A")
    Dim rngNameB As Range: Set rngNameB = wsB.Range("B:B")
    Dim rngSumB As Range: Set rngSumB = wsB.Range("C:C")

    Dim rgO As Range: Set rgO = wsO.Range("A1").CurrentRegion
    Dim lastO As Long: lastO = rgO.Rows.Count

    wsOut.Cells.Clear
    wsOut.Range("A1:D1").Value = Array("コード", "他合計", "名称", "合計")
    wsOut.Range("A2").Resize(lastO - 1, rgO.Columns.Count).Value = rgO.Offset(1).Resize(lastO - 1).Value

    '名称（C列）
    With wsOut.Range("C2:C" & lastO)
        .FormulaR1C1 = "=IFERROR(INDEX(" & rngNameB.Address(True, True, xlA1, True) & _
                         ",MATCH(RC1," & rngKeyB.Address(True, True, xlA1, True) & ",0)),"""")"
        .Value = .Value
    End With
    '合計（D列）
    With wsOut.Range("D2:D" & lastO)
        .FormulaR1C1 = "=IFERROR(INDEX(" & rngSumB.Address(True, True, xlA1, True) & _
                         ",MATCH(RC1," & rngKeyB.Address(True, True, xlA1, True) & ",0)),0)"
        .Value = .Value
    End With

    wsOut.Columns.AutoFit
End Sub
VB
  • ポイント
    • 列順が変わっても安全。参照は列範囲で固定。
    • 値化で軽量・壊れにくい。

爆速・堅牢：配列＋辞書で右外部結合（大量行向け）

Sub RightJoin_Dictionary()
    '基準: A=コード, B=名称, C=合計
    '相手: A=コード, B=他合計
    '出力: 相手キー全件＋基準の値（無ければ補完）を一括出力

    Dim wsB As Worksheet: Set wsB = Worksheets("基準")
    Dim wsO As Worksheet: Set wsO = Worksheets("相手")
    Dim wsOut As Worksheet
    On Error Resume Next
    Set wsOut = Worksheets("右外部結合")
    If wsOut Is Nothing Then Set wsOut = Worksheets.Add: wsOut.Name = "右外部結合"
    On Error GoTo 0

    wsOut.Cells.Clear
    wsOut.Range("A1:D1").Value = Array("コード", "他合計", "名称", "合計")

    '基準→辞書（コード→(名称,合計)）
    Dim vb As Variant: vb = wsB.Range("A1").CurrentRegion.Value
    Dim base As Object: Set base = CreateObject("Scripting.Dictionary")
    Dim i As Long, key As String
    For i = 2 To UBound(vb, 1)
        key = UCase$(Trim$(CStr(vb(i, 1))))
        If Len(key) > 0 Then base(key) = Array(CStr(vb(i, 2)), Val(vb(i, 3)))
    Next

    '相手→配列（相手キーを全件出すのが右外部）
    Dim vo As Variant: vo = wsO.Range("A1").CurrentRegion.Value
    Dim out() As Variant: ReDim out(1 To UBound(vo, 1), 1 To 4)
    out(1, 1) = "コード": out(1, 2) = "他合計": out(1, 3) = "名称": out(1, 4) = "合計"

    Dim r As Long
    For r = 2 To UBound(vo, 1)
        key = UCase$(Trim$(CStr(vo(r, 1))))
        out(r, 1) = vo(r, 1)                    'コード（相手）
        out(r, 2) = Val(vo(r, 2))               '他合計（相手）
        If base.Exists(key) Then
            out(r, 3) = base(key)(0)            '名称（基準）
            out(r, 4) = base(key)(1)            '合計（基準）
        Else
            out(r, 3) = ""                      '欠損補完
            out(r, 4) = 0
        End If
    Next

    wsOut.Range("A1").Resize(UBound(out, 1), 4).Value = out
    wsOut.Columns.AutoFit
End Sub
VB
  • ポイント
    • 相手側のキーを「全件」出す。基準が無い場合は補完（空欄/0）。
    • セル往復ゼロで高速。キーは Trim/UCase で正規化。

見出し名で安全に列特定（列順変更に強い）

Private Function FindHeader(ByVal headerRow As Range, ByVal name As String) As Long
    Dim hit As Range
    Set hit = headerRow.Find(What:=name, LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
    FindHeader = IIf(hit Is Nothing, 0, hit.Column)
End Function

Sub RightJoin_ByHeaders()
    '見出し名で列位置を取得して右外部結合
    Dim wsB As Worksheet: Set wsB = Worksheets("基準")
    Dim wsO As Worksheet: Set wsO = Worksheets("相手")
    Dim rgB As Range: Set rgB = wsB.Range("A1").CurrentRegion
    Dim rgO As Range: Set rgO = wsO.Range("A1").CurrentRegion

    Dim cKeyB As Long: cKeyB = FindHeader(rgB.Rows(1), "コード")
    Dim cNameB As Long: cNameB = FindHeader(rgB.Rows(1), "名称")
    Dim cSumB As Long: cSumB = FindHeader(rgB.Rows(1), "合計")
    Dim cKeyO As Long: cKeyO = FindHeader(rgO.Rows(1), "コード")
    Dim cValO As Long: cValO = FindHeader(rgO.Rows(1), "他合計")
    If cKeyB * cNameB * cSumB * cKeyO * cValO = 0 Then MsgBox "見出し不足": Exit Sub

    '基準→辞書（コード→(名称,合計)）
    Dim vm As Variant: vm = rgB.Value
    Dim base As Object: Set base = CreateObject("Scripting.Dictionary")
    Dim i As Long, key As String
    For i = 2 To UBound(vm, 1)
        key = UCase$(Trim$(CStr(vm(i, cKeyB))))
        base(key) = Array(CStr(vm(i, cNameB)), Val(vm(i, cSumB)))
    Next

    '相手全件を出力しつつ基準を横付け
    Dim vo As Variant: vo = rgO.Value
    Dim wsOut As Worksheet
    On Error Resume Next
    Set wsOut = Worksheets("右外部結合")
    If wsOut Is Nothing Then Set wsOut = Worksheets.Add: wsOut.Name = "右外部結合"
    On Error GoTo 0

    wsOut.Cells.Clear
    wsOut.Range("A1:D1").Value = Array("コード", "他合計", "名称", "合計")

    Dim rOut As Long: rOut = 2
    For i = 2 To UBound(vo, 1)
        key = UCase$(Trim$(CStr(vo(i, cKeyO))))
        wsOut.Cells(rOut, 1).Value = vo(i, cKeyO)
        wsOut.Cells(rOut, 2).Value = Val(vo(i, cValO))
        If base.Exists(key) Then
            wsOut.Cells(rOut, 3).Value = base(key)(0)
            wsOut.Cells(rOut, 4).Value = base(key)(1)
        Else
            wsOut.Cells(rOut, 3).Value = ""
            wsOut.Cells(rOut, 4).Value = 0
        End If
        rOut = rOut + 1
    Next
    wsOut.Columns.AutoFit
End Sub
VB
  • ポイント
    • 列順・列追加に強い。見出し名で位置を動的取得。
    • 欠損補完は運用に合わせて空欄/0/「#N/A」などを選ぶ。

複数キーの右外部結合（部署×年月など）

相手表の「部署×年月」全件を出し、基準から該当値を横付けします。

Sub RightJoin_MultiKey()
    '基準: A=部署, B=年月, C=合計
    '相手: A=部署, B=年月, C=他合計
    Dim wsB As Worksheet: Set wsB = Worksheets("基準")
    Dim wsO As Worksheet: Set wsO = Worksheets("相手")
    Dim wsOut As Worksheet
    On Error Resume Next
    Set wsOut = Worksheets("右外部結合_複数キー")
    If wsOut Is Nothing Then Set wsOut = Worksheets.Add: wsOut.Name = "右外部結合_複数キー"
    On Error GoTo 0

    wsOut.Cells.Clear
    wsOut.Range("A1:E1").Value = Array("部署", "年月", "他合計", "名称/合計（基準）", "キー")

    '基準辞書（key="部署|年月" → (名称,合計)）
    Dim vb As Variant: vb = wsB.Range("A1").CurrentRegion.Value
    Dim base As Object: Set base = CreateObject("Scripting.Dictionary")
    Dim i As Long, k As String
    For i = 2 To UBound(vb, 1)
        k = UCase$(Trim$(CStr(vb(i, 1)))) & "|" & UCase$(Trim$(CStr(vb(i, 2))))
        base(k) = Array(CStr(vb(i, 1)) & " " & CStr(vb(i, 2)), Val(vb(i, 3)))
    Next

    '相手全件を出力（右外部）
    Dim vo As Variant: vo = wsO.Range("A1").CurrentRegion.Value
    Dim rOut As Long: rOut = 2
    For i = 2 To UBound(vo, 1)
        k = UCase$(Trim$(CStr(vo(i, 1)))) & "|" & UCase$(Trim$(CStr(vo(i, 2))))
        wsOut.Cells(rOut, 1).Value = vo(i, 1)           '部署（相手）
        wsOut.Cells(rOut, 2).Value = vo(i, 2)           '年月（相手）
        wsOut.Cells(rOut, 3).Value = Val(vo(i, 3))      '他合計（相手）
        If base.Exists(k) Then
            wsOut.Cells(rOut, 4).Value = base(k)(0) & " / " & base(k)(1)
        Else
            wsOut.Cells(rOut, 4).Value = ""
        End If
        wsOut.Cells(rOut, 5).Value = k
        rOut = rOut + 1
    Next
    wsOut.Columns.AutoFit
End Sub
VB
  • ポイント
    • 複合キーは "|" など安全な区切りで連結。年月は表記統一（例：yyyy-mm）を推奨。
    • 監査しやすいようキー列を出すと、突合確認が楽。

よくある落とし穴と対策

  • 右外部の“基準”を取り違える
    • 対策: 相手表のキー全件を必ず出す。基準値は“付けられる分だけ”横付け。
  • キー表記揺れで結合ミス
    • 対策: Trim/UCase で正規化。必要なら半角化（StrConv(..., vbNarrow)）や不要記号の Replace。
  • 年月の型不一致
    • 対策: 連結前に Format$(DateValue(日付), "yyyy-mm") などで統一。
  • 数値が文字列で合計ずれ
    • 対策: Val で数値化。式は .Value = .Value で値化。
  • 速度・安定性
    • 対策: 範囲→配列→辞書→一括貼付。前後で ScreenUpdating/Calculation/Events を停止→復帰。

例題で練習

'例1：相手表を基準にVLOOKUPで右外部結合（値化）
Sub Example_Right_VLookup()
    RightJoin_VLookup
End Sub

'例2：INDEX/MATCHで列増減に強い右外部結合
Sub Example_Right_IndexMatch()
    RightJoin_IndexMatch
End Sub

'例3：配列＋辞書で高速な右外部結合
Sub Example_Right_Dict()
    RightJoin_Dictionary
End Sub

'例4：複数キー（部署×年月）の右外部結合
Sub Example_Right_MultiKey()
    RightJoin_MultiKey
End Sub
VB
スポンサーリンク
タイトルとURLをコピーしました