Excel VBA 逆引き集 | 同一ファイル内の差分

Excel VBA
スポンサーリンク

同一ファイル内の差分

「同じブックの中で、シートAとシートBを比べて違いを見たい」——外部ファイルを使わずに、同一ファイル内で差分を取るテンプレです。初心者でも理解しやすいように、コード例をかみ砕いて説明します。


差分の基本パターン

  • 同じブック内の2シート比較
    例:Sheet1(前月)とSheet2(今月)を突合。
  • 3分類:
    • 新規(Bのみ)
    • 削除(Aのみ)
    • 変更(両方あるが値が違う)

共通ユーティリティ(速度・安全)

Option Explicit

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

Private Function NormKey(ByVal v As Variant) As String
    NormKey = UCase$(Trim$(CStr(v)))
End Function

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

基本テンプレ:同一ファイル内の差分レポート

「SheetA」と「SheetB」を比較して、新規・削除・変更を別シートに出力します。

Sub Diff_Sheets_InSameFile()
    SpeedOn

    Dim wsA As Worksheet: Set wsA = Worksheets("SheetA")
    Dim wsB As Worksheet: Set wsB = Worksheets("SheetB")
    Dim rgA As Range: Set rgA = wsA.Range("A1").CurrentRegion
    Dim rgB As Range: Set rgB = wsB.Range("A1").CurrentRegion
    Dim vA As Variant: vA = rgA.Value
    Dim vB As Variant: vB = rgB.Value

    'キー列は1列目(コード)想定
    Dim dictB As Object: Set dictB = CreateObject("Scripting.Dictionary")
    Dim i As Long, k As String
    For i = 2 To UBound(vB, 1)
        k = NormKey(vB(i, 1))
        If Len(k) > 0 Then dictB(k) = i
    Next

    '出力シート
    Dim wsNew As Worksheet: Set wsNew = EnsureSheet("新規(Bのみ)", True)
    Dim wsDel As Worksheet: Set wsDel = EnsureSheet("削除(Aのみ)", True)
    Dim wsChg As Worksheet: Set wsChg = EnsureSheet("変更差分", True)

    wsNew.Range("A1:C1").Value = Array("コード", "名称(B)", "単価(B)")
    wsDel.Range("A1:C1").Value = Array("コード", "名称(A)", "単価(A)")
    wsChg.Range("A1:E1").Value = Array("コード", "項目", "A値", "B値", "差分")

    Dim rNew As Long: rNew = 2
    Dim rDel As Long: rDel = 2
    Dim rChg As Long: rChg = 2

    'A基準で削除・変更
    Dim setA As Object: Set setA = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(vA, 1)
        k = NormKey(vA(i, 1))
        If Len(k) = 0 Then GoTo contA
        setA(k) = True

        If dictB.Exists(k) Then
            Dim rb As Long: rb = dictB(k)
            '名称
            If CStr(vA(i, 2)) <> CStr(vB(rb, 2)) Then
                wsChg.Cells(rChg, 1).Value = vA(i, 1)
                wsChg.Cells(rChg, 2).Value = "名称"
                wsChg.Cells(rChg, 3).Value = vA(i, 2)
                wsChg.Cells(rChg, 4).Value = vB(rb, 2)
                rChg = rChg + 1
            End If
            '単価
            Dim aPrice As Double: aPrice = CDbl(Val(vA(i, 3)))
            Dim bPrice As Double: bPrice = CDbl(Val(vB(rb, 3)))
            If aPrice <> bPrice Then
                wsChg.Cells(rChg, 1).Value = vA(i, 1)
                wsChg.Cells(rChg, 2).Value = "単価"
                wsChg.Cells(rChg, 3).Value = aPrice
                wsChg.Cells(rChg, 4).Value = bPrice
                wsChg.Cells(rChg, 5).Value = bPrice - aPrice
                rChg = rChg + 1
            End If
        Else
            wsDel.Cells(rDel, 1).Value = vA(i, 1)
            wsDel.Cells(rDel, 2).Value = vA(i, 2)
            wsDel.Cells(rDel, 3).Value = vA(i, 3)
            rDel = rDel + 1
        End If
contA:
    Next

    'Bのみ(新規)
    Dim j As Long
    For j = 2 To UBound(vB, 1)
        k = NormKey(vB(j, 1))
        If Len(k) > 0 And Not setA.Exists(k) Then
            wsNew.Cells(rNew, 1).Value = vB(j, 1)
            wsNew.Cells(rNew, 2).Value = vB(j, 2)
            wsNew.Cells(rNew, 3).Value = vB(j, 3)
            rNew = rNew + 1
        End If
    Next

    wsNew.Columns.AutoFit: wsDel.Columns.AutoFit: wsChg.Columns.AutoFit
    SpeedOff
    MsgBox "差分: 新規=" & rNew - 2 & " 削除=" & rDel - 2 & " 変更=" & rChg - 2
End Sub
VB

例題で練習

'例1:同一ファイル内でシートAとBを比較
Sub Example_DiffSheets()
    Diff_Sheets_InSameFile
End Sub
VB

初心者向けポイント

  • 同一ファイル内: 外部CSVや別ブックを使わず、シート間比較で完結。
  • 3分類: 新規・削除・変更を別シートに出すと確認が楽。
  • 数値差分: 単価などは差分も出すと分析に便利。
  • 辞書+配列: セルを1つずつ見るより高速で安全。

実務の落とし穴と対策

  • キー表記揺れで誤判定 → NormKeyでTrim+UCase。
  • 列順変更で壊れる → FindHeaderで見出し名から列特定する版に拡張可能。
  • 大量行で遅い → SpeedOn/Offで高速化。
タイトルとURLをコピーしました