Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – 差分抽出テンプレ

Excel VBA
スポンサーリンク

ねらい：差分抽出を「速く・正確・壊れない」型にして、毎日の更新チェックを自動化する

差分抽出は「追加・削除・変更」を正しく切り分ける作業です。Excelの目視や関数だと抜けが出ますが、VBAなら“配列I/O＋Dictionary＋正規化＋ハッシュ”で、10万行規模でも一瞬で正確に判定できます。初心者でも貼って動くテンプレを、単一キー・複合キー・選択列ハッシュ・変更点の列別表示・見える化までかみ砕いて解説します。

基盤部品：配列I/O・キー正規化・安全な複合キー

配列一括読み書きとキー生成

' ModDiff_Base.bas
Option Explicit
Private Const SEP As String = Chr$(30) ' 複合キーの安全な区切り

Public Function ReadRegion(ByVal ws As Worksheet, Optional ByVal topLeft As String = "A1") As Variant
    ReadRegion = ws.Range(topLeft).CurrentRegion.Value
End Function

Public Sub WriteBlock(ByVal ws As Worksheet, ByVal a As Variant, ByVal topLeft As String)
    ws.Range(topLeft).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Public Function NormKey(ByVal v As Variant) As String
    NormKey = LCase$(Trim$(CStr(v))) ' 大小・余分スペースの揺らぎを除去
End Function

Public Function MakeKey2(ByVal v1 As Variant, ByVal v2 As Variant) As String
    MakeKey2 = NormKey(v1) & SEP & NormKey(v2)
End Function
VB

重要ポイントの深掘り

  • ヘッダは1行目固定、データは2行目から扱うと事故が激減します。
  • キーは必ず正規化（Trim/LCase）。片側だけではヒット漏れが起きます。
  • 複合キーは“ありえない文字”で束ねて誤連結を根絶します（例：ab|c と a|bc が同じになる事故を防ぐ）。

差分の基本：追加・削除・変更を一撃で抽出する

単一キーで差分抽出（選択列をハッシュ比較）

' ModDiff_Simple.bas
Option Explicit

' oldSheet: 旧データ（A=キー）
' newSheet: 新データ（A=キー）
' keyCol は A 固定想定、compareColsCsv 例 "B,C,D"（比較対象列の集合）
' 出力：TableDiff に Type(Key/ADDED/DELETED/CHANGED), Key, OldHash, NewHash
Public Sub DiffTables(ByVal oldSheet As String, ByVal newSheet As String, ByVal compareColsCsv As String, ByVal outStart As String)
    Dim o As Variant: o = ReadRegion(Worksheets(oldSheet))
    Dim n As Variant: n = ReadRegion(Worksheets(newSheet))
    Dim cmpIdx() As Long: cmpIdx = ColsToIndex(compareColsCsv)

    Dim dOld As Object: Set dOld = CreateObject("Scripting.Dictionary"): dOld.CompareMode = 1
    Dim hOld As Object: Set hOld = CreateObject("Scripting.Dictionary"): hOld.CompareMode = 1

    Dim r As Long
    For r = 2 To UBound(o, 1)
        Dim k As String: k = NormKey(o(r, 1))
        dOld(k) = r
        hOld(k) = RowHash(o, r, cmpIdx)
    Next

    Dim out() As Variant: ReDim out(1 To 1, 1 To 4)
    out(1, 1) = "Type": out(1, 2) = "Key": out(1, 3) = "OldHash": out(1, 4) = "NewHash"
    Dim rowsOut As Long: rowsOut = 1

    Dim seen As Object: Set seen = CreateObject("Scripting.Dictionary"): seen.CompareMode = 1
    For r = 2 To UBound(n, 1)
        Dim k As String: k = NormKey(n(r, 1))
        Dim hn As String: hn = RowHash(n, r, cmpIdx)
        seen(k) = True
        If Not dOld.Exists(k) Then
            rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 4)
            out(rowsOut, 1) = "ADDED": out(rowsOut, 2) = k: out(rowsOut, 4) = hn
        ElseIf hOld(k) <> hn Then
            rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 4)
            out(rowsOut, 1) = "CHANGED": out(rowsOut, 2) = k: out(rowsOut, 3) = hOld(k): out(rowsOut, 4) = hn
        End If
    Next

    Dim k As Variant
    For Each k In dOld.Keys
        If Not seen.Exists(k) Then
            rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 4)
            out(rowsOut, 1) = "DELETED": out(rowsOut, 2) = k: out(rowsOut, 3) = hOld(k)
        End If
    Next

    WriteBlock Worksheets(oldSheet), out, outStart
End Sub

Private Function ColsToIndex(ByVal csv As String) As Long()
    Dim p() As String: p = Split(csv, ",")
    Dim idx() As Long: ReDim idx(0 To UBound(p))
    Dim i As Long
    For i = 0 To UBound(p): idx(i) = Range(Trim$(p(i)) & "1").Column: Next
    ColsToIndex = idx
End Function

Private Function RowHash(ByVal a As Variant, ByVal r As Long, ByVal idx() As Long) As String
    Dim i As Long, s As String
    For i = LBound(idx) To UBound(idx)
        s = s & NormKey(a(r, idx(i))) & "|" ' 正規化＋区切り
    Next
    RowHash = s ' 実務は SHA-256 などに差し替え可
End Function
VB

重要ポイントの深掘り

  • 比較対象列を“文字で列指定”できるようにすると、列追加・入れ替えに強くなります（”B,D,F”）。
  • “変更”は値の組をハッシュ（ここでは簡易連結）で比較します。実務は SHA-256に置換するとより堅牢です。
  • 追加・削除はキー辞書と“見た”フラグで簡潔に抽出できます。

列別の変更点を出す：どの列が変わったのかを可視化

CHANGEDの詳細（列ごと Old→New を出力）

' ModDiff_ColumnDetail.bas
Option Explicit

' DiffTables で作成した CHANGED を列ごとに展開
' oldSheet/newSheet は同じ構造前提
Public Sub DiffColumnDetails(ByVal oldSheet As String, ByVal newSheet As String, ByVal compareColsCsv As String, ByVal outStart As String)
    Dim o As Variant: o = ReadRegion(Worksheets(oldSheet))
    Dim n As Variant: n = ReadRegion(Worksheets(newSheet))
    Dim idx() As Long: idx = ColsToIndex(compareColsCsv)

    Dim dOldRow As Object: Set dOldRow = CreateObject("Scripting.Dictionary"): dOldRow.CompareMode = 1
    Dim r As Long
    For r = 2 To UBound(o, 1)
        dOldRow(NormKey(o(r, 1))) = r
    Next

    Dim out() As Variant: ReDim out(1 To 1, 1 To 5)
    out(1, 1) = "Key": out(1, 2) = "Column": out(1, 3) = "Old": out(1, 4) = "New": out(1, 5) = "Changed"

    Dim rowsOut As Long: rowsOut = 1
    Dim c As Long
    For r = 2 To UBound(n, 1)
        Dim k As String: k = NormKey(n(r, 1))
        If dOldRow.Exists(k) Then
            Dim ro As Long: ro = dOldRow(k)
            For c = LBound(idx) To UBound(idx)
                Dim col As Long: col = idx(c)
                Dim oldVal As String: oldVal = CStr(o(ro, col))
                Dim newVal As String: newVal = CStr(n(r, col))
                If oldVal <> newVal Then
                    rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 5)
                    out(rowsOut, 1) = k
                    out(rowsOut, 2) = Worksheets(oldSheet).Cells(1, col).Value ' 列名
                    out(rowsOut, 3) = oldVal
                    out(rowsOut, 4) = newVal
                    out(rowsOut, 5) = "Y"
                End If
            Next
        End If
    Next
    WriteBlock Worksheets(oldSheet), out, outStart
End Sub
VB

重要ポイントの深掘り

  • 変更の“詳細”を列名付きで出すと、現場修正が一気に早くなります。
  • 値の比較は正規化の方針に合わせる（大小無視、前後空白除去など）。必要なら old/new を NormKey 化して比較します。

複合キー差分：A+Bで一致判定、選択列ハッシュ

2列キーの差分抽出テンプレ

' ModDiff_Composite.bas
Option Explicit
Private Const SEP As String = Chr$(30)

Public Sub DiffTables2Keys(ByVal oldSheet As String, ByVal newSheet As String, ByVal compareColsCsv As String, ByVal outStart As String)
    Dim o As Variant: o = ReadRegion(Worksheets(oldSheet))
    Dim n As Variant: n = ReadRegion(Worksheets(newSheet))
    Dim cmpIdx() As Long: cmpIdx = ColsToIndex(compareColsCsv)

    Dim dOld As Object: Set dOld = CreateObject("Scripting.Dictionary"): dOld.CompareMode = 1
    Dim hOld As Object: Set hOld = CreateObject("Scripting.Dictionary"): hOld.CompareMode = 1

    Dim r As Long
    For r = 2 To UBound(o, 1)
        Dim k As String: k = NormKey(o(r, 1)) & SEP & NormKey(o(r, 2))
        dOld(k) = r: hOld(k) = RowHash(o, r, cmpIdx)
    Next

    Dim out() As Variant: ReDim out(1 To 1, 1 To 4)
    out(1, 1) = "Type": out(1, 2) = "Key(A|B)": out(1, 3) = "OldHash": out(1, 4) = "NewHash"
    Dim rowsOut As Long: rowsOut = 1

    Dim seen As Object: Set seen = CreateObject("Scripting.Dictionary"): seen.CompareMode = 1
    For r = 2 To UBound(n, 1)
        Dim k As String: k = NormKey(n(r, 1)) & SEP & NormKey(n(r, 2))
        Dim hn As String: hn = RowHash(n, r, cmpIdx)
        seen(k) = True
        If Not dOld.Exists(k) Then
            rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 4)
            out(rowsOut, 1) = "ADDED": out(rowsOut, 2) = k: out(rowsOut, 4) = hn
        ElseIf hOld(k) <> hn Then
            rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 4)
            out(rowsOut, 1) = "CHANGED": out(rowsOut, 2) = k: out(rowsOut, 3) = hOld(k): out(rowsOut, 4) = hn
        End If
    Next

    Dim k As Variant
    For Each k In dOld.Keys
        If Not seen.Exists(k) Then
            rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 4)
            out(rowsOut, 1) = "DELETED": out(rowsOut, 2) = k: out(rowsOut, 3) = hOld(k)
        End If
    Next

    WriteBlock Worksheets(oldSheet), out, outStart
End Sub
VB

重要ポイントの深掘り

  • 複合キーは“安全な区切り”必須。単純連結は衝突の温床です。
  • 比較対象列は、実務要件に合わせて選択（例：計算に効く列だけ）。不要列まで含めると“ノイズ変更”で差分が増えます。

差分の見える化と品質監査：色分け・件数サマリ・種別別出力

1枚で赤黄緑をパッと分かるビュー

' ModDiff_View.bas
Option Explicit

Public Sub ViewDiff(ByVal diffSheet As String)
    Dim ws As Worksheet: Set ws = Worksheets(diffSheet)
    With ws.Range("A1").CurrentRegion
        .Columns.AutoFit
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$A2=""ADDED"""
        .FormatConditions(1).Interior.Color = RGB(200, 255, 200) ' 緑
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$A2=""DELETED"""
        .FormatConditions(2).Interior.Color = RGB(255, 200, 200) ' 赤
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$A2=""CHANGED"""
        .FormatConditions(3).Interior.Color = RGB(255, 255, 180) ' 黄
    End With
End Sub
VB

種別別に分割出力（配布・レビュー用）

' ADDED/DELETED/CHANGED を3シートに分ける
Public Sub SplitDiff(ByVal diffSheet As String)
    Dim a As Variant: a = Worksheets(diffSheet).Range("A1").CurrentRegion.Value
    Dim added() As Variant: added = FilterByType(a, "ADDED")
    Dim deleted() As Variant: deleted = FilterByType(a, "DELETED")
    Dim changed() As Variant: changed = FilterByType(a, "CHANGED")
    WriteBlock PrepareOut("Diff_ADDED"), added, "A1"
    WriteBlock PrepareOut("Diff_DELETED"), deleted, "A1"
    WriteBlock PrepareOut("Diff_CHANGED"), changed, "A1"
End Sub

Private Function FilterByType(ByVal a As Variant, ByVal typ As String) As Variant
    Dim out() As Variant: ReDim out(1 To 1, 1 To UBound(a, 2))
    Dim c As Long: For c = 1 To UBound(a, 2): out(1, c) = a(1, c): Next
    Dim rowsOut As Long: rowsOut = 1
    Dim r As Long
    For r = 2 To UBound(a, 1)
        If CStr(a(r, 1)) = typ Then
            rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To UBound(a, 2))
            For c = 1 To UBound(a, 2): out(rowsOut, c) = a(r, c): Next
        End If
    Next
    FilterByType = out
End Function

Private Function PrepareOut(ByVal name As String) 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: ws.Name = name
    ws.Cells.Clear
    Set PrepareOut = ws
End Function
VB

重要ポイントの深掘り

  • 色分けは“意図が一目”。レビューの時間が短縮し、見落としが減ります。
  • 種別別シートは配布・承認の実務で便利。特定種別だけ回収・反映しやすくなります。

実例の通し方：旧マスタ vs 新マスタの差分抽出→変更詳細→ビュー

実行例

' ModDiff_Example.bas
Option Explicit

Public Sub Demo_DiffPipeline()
    ' 1) 差分抽出（Aをキー、B～Dを比較）
    DiffTables "Master_Old", "Master_New", "B,D", "Z1"
    ' 2) 変更詳細（列別 Old→New）
    DiffColumnDetails "Master_Old", "Master_New", "B,D", "AA1"
    ' 3) 見える化
    ViewDiff "Master_Old" ' Z1から出した差分領域を条件付き書式で色分け
    ' 4) 種別別に分割（任意）
    SplitDiff "Master_Old"
    MsgBox "差分抽出テンプレのパイプラインが完了しました。", vbInformation
End Sub
VB

期待動作の確認ポイント

  • ADDED/DELETED/CHANGED の3種が正しく分類され、変更は列単位で確認できます。
  • 条件付き書式で色分けされ、レビューと承認が早くなります。
  • 比較列を増減しても、文字指定を変えるだけで追随可能です。

落とし穴と対策（深掘り）

正規化不足で誤差分・見逃し

Trim/LCaseを両側で必ず通す。必要なら全半角統一、余計な記号除去の前処理も追加。

比較列の選び方が曖昧

業務に効く列だけ選ぶ。ノイズ列（更新日時など）を比較に入れると“毎回変更”になりがち。

セル逐次書きで遅い・固まる

結果は配列で作成し、一括書き戻し。10万行でも一瞬。UIが固まりません。

ハッシュが甘く誤判定

簡易連結は手軽だが、実務は SHA-256 への差し替えを推奨。PowerShell連携や外部DLLなしでも実装可能です。

まとめ：差分は「キー辞書＋選択列ハッシュ＋配列一括」で“速く・正確・運用に強い”

  • 追加・削除・変更を一撃抽出、列別詳細で修正が速い。
  • 複合キー・比較列指定・色分け・種別分割で、実務のレビュー・配布に直結。
  • 正規化・列設計・一括書き戻しの型を守れば、規模が大きくても壊れません。

スポンサーリンク
タイトルとURLをコピーしました