同一ファイル内の差分
「同じブックの中で、シート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で高速化。
