Excel VBA 逆引き集 | JOIN 高速テンプレ（辞書版）

Excel VBA
スポンサーリンク

JOIN 高速テンプレ（辞書版）

JOINを速く、安定して。コツは「範囲→配列→辞書→一括貼付」、そして「キーの正規化」「見出し名で列特定」。初心者でも貼って動くように、左結合・内結合・見出し対応・外部ブック対応まで最短テンプレをまとめました。

高速化の基本セット

  • 画面/イベント/計算の停止:
    目的: 無駄な再描画・イベント発火・再計算を止める。
    使い方: 処理前後でオン/オフ。
Private Sub SpeedOn()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
End Sub

Private Sub SpeedOff()
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
VB
  • 新シートの安全作成:
    目的: 何度実行しても壊れない。
Private Function EnsureSheet(ByVal name As String, Optional ByVal clear As Boolean = True) As Worksheet
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets(name)
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        ws.Name = name
    End If
    If clear Then ws.Cells.Clear
    Set EnsureSheet = ws
End Function
VB
  • 見出し名で列特定:
    目的: 列順が変わっても壊れない。
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
VB
  • キーの正規化（表記揺れ対策）:
    目的: Trim/UCaseで一致漏れ防止。
Private Function NormKey(ByVal v As Variant) As String
    NormKey = UCase$(Trim$(CStr(v)))
End Function
VB

左結合（明細基準）最短テンプレ

「明細にマスタを横付け」する定番。10万行でも実用レベルで動きます。

Sub Join_Left_Fast()
    SpeedOn

    '明細: Sheet("明細") A=コード, B=数量
    'マスタ: Sheet("マスタ") A=コード, B=名称, C=単価
    Dim vD As Variant: vD = Worksheets("明細").Range("A1").CurrentRegion.Value
    Dim vM As Variant: vM = Worksheets("マスタ").Range("A1").CurrentRegion.Value

    '辞書（キー→(名称,単価)）
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim i As Long, k As String
    For i = 2 To UBound(vM, 1)
        k = NormKey(vM(i, 1))
        If Len(k) > 0 Then dict(k) = Array(CStr(vM(i, 2)), CDbl(Val(vM(i, 3))))
    Next

    '出力配列（ヘッダー＋データ）
    Dim out() As Variant: ReDim out(1 To UBound(vD, 1), 1 To 5)
    out(1, 1) = "コード": out(1, 2) = "名称": out(1, 3) = "単価": out(1, 4) = "数量": out(1, 5) = "金額"

    Dim r As Long
    For r = 2 To UBound(vD, 1)
        Dim kd As String: kd = NormKey(vD(r, 1))
        Dim qty As Double: qty = CDbl(Val(vD(r, 2)))
        out(r, 1) = vD(r, 1)
        out(r, 4) = qty
        If dict.Exists(kd) Then
            out(r, 2) = dict(kd)(0)
            out(r, 3) = dict(kd)(1)
            out(r, 5) = dict(kd)(1) * qty
        Else
            out(r, 2) = "#N/A": out(r, 3) = 0: out(r, 5) = 0
        End If
    Next

    With EnsureSheet("LEFT_JOIN", True)
        .Range("A1").Resize(UBound(out, 1), UBound(out, 2)).Value = out
        .Rows(1).Font.Bold = True
        .Columns.AutoFit
    End With

    SpeedOff
End Sub
VB
  • ポイント
    • 正規化: NormKey を両側に適用。
    • 数値化: Val→CDbl で計算ズレ回避。
    • 一括貼付: セル往復ゼロで高速。

内結合（一致行のみ）高速テンプレ

一致した行だけに絞って出力。配列サイズを先に見積もるので無駄がない。

Sub Join_Inner_Fast()
    SpeedOn

    Dim vD As Variant: vD = Worksheets("明細").Range("A1").CurrentRegion.Value
    Dim vM As Variant: vM = Worksheets("マスタ").Range("A1").CurrentRegion.Value

    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim i As Long, k As String
    For i = 2 To UBound(vM, 1)
        k = NormKey(vM(i, 1))
        If Len(k) > 0 Then dict(k) = Array(CStr(vM(i, 2)), CDbl(Val(vM(i, 3))))
    Next

    '件数見積もり
    Dim cnt As Long: cnt = 1
    Dim r As Long
    For r = 2 To UBound(vD, 1)
        If dict.Exists(NormKey(vD(r, 1))) Then cnt = cnt + 1
    Next

    Dim out() As Variant: ReDim out(1 To cnt, 1 To 5)
    out(1, 1) = "コード": out(1, 2) = "名称": out(1, 3) = "単価": out(1, 4) = "数量": out(1, 5) = "金額"

    Dim w As Long: w = 2
    For r = 2 To UBound(vD, 1)
        k = NormKey(vD(r, 1))
        If dict.Exists(k) Then
            Dim qty As Double: qty = CDbl(Val(vD(r, 2)))
            out(w, 1) = vD(r, 1)
            out(w, 2) = dict(k)(0)
            out(w, 3) = dict(k)(1)
            out(w, 4) = qty
            out(w, 5) = dict(k)(1) * qty
            w = w + 1
        End If
    Next

    With EnsureSheet("INNER_JOIN", True)
        .Range("A1").Resize(cnt, 5).Value = out
        .Rows(1).Font.Bold = True
        .Columns.AutoFit
    End With

    SpeedOff
End Sub
VB
  • ポイント
    • 見積もり→確保: 無駄な ReDim を避けて速い。
    • 未一致行は出さない: レポートや抽出に向く。

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

現場の列追加・順序変更に強いテンプレ。見出し不足は早期検知。

Sub Join_Left_ByHeaders_Fast()
    SpeedOn

    Dim rgD As Range: Set rgD = Worksheets("明細").Range("A1").CurrentRegion
    Dim rgM As Range: Set rgM = Worksheets("マスタ").Range("A1").CurrentRegion
    Dim vD As Variant: vD = rgD.Value
    Dim vM As Variant: vM = rgM.Value

    Dim cKeyD As Long: cKeyD = FindHeader(rgD.Rows(1), "コード")
    Dim cQtyD As Long: cQtyD = FindHeader(rgD.Rows(1), "数量")
    Dim cKeyM As Long: cKeyM = FindHeader(rgM.Rows(1), "コード")
    Dim cNameM As Long: cNameM = FindHeader(rgM.Rows(1), "名称")
    Dim cPriceM As Long: cPriceM = FindHeader(rgM.Rows(1), "単価")
    If cKeyD * cQtyD * cKeyM * cNameM * cPriceM = 0 Then
        SpeedOff: MsgBox "見出し不足（コード/数量/名称/単価）": Exit Sub
    End If

    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim i As Long, k As String
    For i = 2 To UBound(vM, 1)
        k = NormKey(vM(i, cKeyM))
        If Len(k) > 0 Then dict(k) = Array(CStr(vM(i, cNameM)), CDbl(Val(vM(i, cPriceM))))
    Next

    Dim out() As Variant: ReDim out(1 To UBound(vD, 1), 1 To 5)
    out(1, 1) = "コード": out(1, 2) = "名称": out(1, 3) = "単価": out(1, 4) = "数量": out(1, 5) = "金額"

    Dim r As Long
    For r = 2 To UBound(vD, 1)
        Dim kd As String: kd = NormKey(vD(r, cKeyD))
        Dim qty As Double: qty = CDbl(Val(vD(r, cQtyD)))
        out(r, 1) = vD(r, cKeyD)
        out(r, 4) = qty
        If dict.Exists(kd) Then
            out(r, 2) = dict(kd)(0)
            out(r, 3) = dict(kd)(1)
            out(r, 5) = dict(kd)(1) * qty
        Else
            out(r, 2) = "#N/A": out(r, 3) = 0: out(r, 5) = 0
        End If
    Next

    With EnsureSheet("LEFT_JOIN_ByHeaders", True)
        .Range("A1").Resize(UBound(vD, 1), 5).Value = out
        .Rows(1).Font.Bold = True
        .Columns.AutoFit
    End With

    SpeedOff
End Sub
VB
  • ポイント
    • 壊れない: 見出し名から列を動的取得。
    • 早期検知: 見出し不足なら即停止。

外部ブックのマスタを辞書化してJOIN（高速）

外部ファイルを開いても配列→辞書→一括貼付にすれば速い。

Sub Join_Left_External_Fast()
    SpeedOn

    '明細: このブック Sheet("明細") A=コード, B=数量
    '外部マスタ: "C:\Data\商品マスタ.xlsx" Sheet("マスタ") A=コード, B=名称, C=単価
    Dim vD As Variant: vD = Worksheets("明細").Range("A1").CurrentRegion.Value

    Dim wbM As Workbook: Set wbM = Workbooks.Open("C:\Data\商品マスタ.xlsx", ReadOnly:=True)
    Dim wsM As Worksheet: Set wsM = wbM.Worksheets("マスタ")
    Dim vM As Variant: vM = wsM.Range("A1").CurrentRegion.Value

    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim i As Long, k As String
    For i = 2 To UBound(vM, 1)
        k = NormKey(vM(i, 1))
        If Len(k) > 0 Then dict(k) = Array(CStr(vM(i, 2)), CDbl(Val(vM(i, 3))))
    Next

    Dim out() As Variant: ReDim out(1 To UBound(vD, 1), 1 To 5)
    out(1, 1) = "コード": out(1, 2) = "名称": out(1, 3) = "単価": out(1, 4) = "数量": out(1, 5) = "金額"

    Dim r As Long
    For r = 2 To UBound(vD, 1)
        k = NormKey(vD(r, 1))
        Dim qty As Double: qty = CDbl(Val(vD(r, 2)))
        out(r, 1) = vD(r, 1)
        out(r, 4) = qty
        If dict.Exists(k) Then
            out(r, 2) = dict(k)(0)
            out(r, 3) = dict(k)(1)
            out(r, 5) = dict(k)(1) * qty
        Else
            out(r, 2) = "#N/A": out(r, 3) = 0: out(r, 5) = 0
        End If
    Next

    wbM.Close SaveChanges:=False

    With EnsureSheet("LEFT_JOIN_External", True)
        .Range("A1").Resize(UBound(vD, 1), 5).Value = out
        .Rows(1).Font.Bold = True
        .Columns.AutoFit
    End With

    SpeedOff
End Sub
VB
  • ポイント
    • 外部ブックは読取専用: 事故防止。
    • 式を使わず値貼り: 速度・安定が段違い。

実務の落とし穴と対策

  • キー表記揺れでJOIN漏れ
    • 対策: Trim＋UCase（必要なら半角化・記号除去も）。正規化は両側同ルール。
  • 数値が文字列で計算ズレ
    • 対策: Val→CDbl で数値化してから計算。書式は出力後に整える。
  • 列順変更で壊れる
    • 対策: FindHeader で列特定。ハードコード禁止。
  • 大量行で遅い
    • 対策: SpeedOn/Off＋配列・辞書・一括貼付。必要なら処理を分割。

例題で練習

'例1：明細基準の左結合（高速）
Sub Example_LeftFast()
    Join_Left_Fast
End Sub

'例2：一致のみの内結合（高速）
Sub Example_InnerFast()
    Join_Inner_Fast
End Sub

'例3：見出し名で列特定して安全に左結合
Sub Example_LeftByHeadersFast()
    Join_Left_ByHeaders_Fast
End Sub

'例4：外部マスタを辞書化して左結合（高速）
Sub Example_LeftExternalFast()
    Join_Left_External_Fast
End Sub
VB
スポンサーリンク
タイトルとURLをコピーしました