差分を色付け
「前月データと今月データを並べて、違うところを色で強調したい」——抽出ではなく“見える化”に特化したテンプレです。初心者でもすぐ使えるように、基本から応用まで例題を交えて解説します。
差分色付けの基本方針
- 比較対象: 同じキー（コードやID）で突合した行、または同じ列位置。
- 色付け:
- 新規（Bのみ）＝淡緑
- 削除（Aのみ）＝淡赤
- 変更（値が違う）＝黄色
- フラグ列: 色だけでなく「変更」「新規」「削除」と文字を残すと後処理が楽。
最短テンプレ：2シートを比較して色付け
「SheetA」と「SheetB」の同じ範囲を比較し、違うセルを黄色に塗ります。
Sub ColorDiff_Basic()
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 r As Long, c As Long
Dim maxRow As Long: maxRow = Application.Min(rgA.Rows.Count, rgB.Rows.Count)
Dim maxCol As Long: maxCol = Application.Min(rgA.Columns.Count, rgB.Columns.Count)
For r = 2 To maxRow '1行目は見出し
For c = 1 To maxCol
If CStr(rgA.Cells(r, c).Value) <> CStr(rgB.Cells(r, c).Value) Then
rgA.Cells(r, c).Interior.Color = RGB(255, 235, 156) '黄色
rgB.Cells(r, c).Interior.Color = RGB(255, 235, 156)
End If
Next c
Next r
End Sub
- ポイント
- 同じ位置のセルを比較して違えば黄色。
- 見出し行は除外（r=2から）。
キー突合で差分色付け（新規／削除／変更）
「コード」をキーにして、AとBを突合。新規・削除は行全体を塗り、変更はセル単位で塗ります。
Sub ColorDiff_ByKey()
Dim wsA As Worksheet: Set wsA = Worksheets("A")
Dim wsB As Worksheet: Set wsB = Worksheets("B")
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
'辞書（Bのキー→行番号）
Dim dictB As Object: Set dictB = CreateObject("Scripting.Dictionary")
Dim i As Long, k As String
For i = 2 To UBound(vB, 1)
k = UCase$(Trim$(CStr(vB(i, 1)))) 'コード列
dictB(k) = i
Next
'色定義
Dim colNew As Long: colNew = RGB(198, 239, 206) '淡緑
Dim colDel As Long: colDel = RGB(255, 199, 206) '淡赤
Dim colChg As Long: colChg = RGB(255, 235, 156) '黄色
'A基準で削除・変更
For i = 2 To UBound(vA, 1)
k = UCase$(Trim$(CStr(vA(i, 1))))
Dim rowA As Long: rowA = rgA.Row + i - 1
If dictB.Exists(k) Then
Dim rowB As Long: rowB = rgB.Row + dictB(k) - 1
Dim c As Long
For c = 2 To rgA.Columns.Count 'キー以外の列
If CStr(vA(i, c)) <> CStr(vB(dictB(k), c)) Then
wsA.Cells(rowA, rgA.Column + c - 1).Interior.Color = colChg
wsB.Cells(rowB, rgB.Column + c - 1).Interior.Color = colChg
End If
Next
Else
wsA.Rows(rowA).Interior.Color = colDel
End If
Next
'Bのみ＝新規
Dim setA As Object: Set setA = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(vA, 1)
setA(UCase$(Trim$(CStr(vA(i, 1))))) = True
Next
For i = 2 To UBound(vB, 1)
k = UCase$(Trim$(CStr(vB(i, 1))))
If Not setA.Exists(k) Then
wsB.Rows(rgB.Row + i - 1).Interior.Color = colNew
End If
Next
End Sub
- ポイント
- 新規: Bのみの行を淡緑。
- 削除: Aのみの行を淡赤。
- 変更: 同じキーで値が違うセルを黄色。
応用：差分フラグ列も追加
色だけでなく「差分フラグ」列を追加すると、後でフィルタや集計が楽です。
Sub ColorDiff_AddFlag()
Dim wsA As Worksheet: Set wsA = Worksheets("A")
Dim rgA As Range: Set rgA = wsA.Range("A1").CurrentRegion
Dim vA As Variant: vA = rgA.Value
Dim flagCol As Long: flagCol = rgA.Columns.Count + rgA.Column
wsA.Cells(1, flagCol).Value = "差分フラグ"
Dim r As Long
For r = 2 To UBound(vA, 1)
If wsA.Rows(rgA.Row + r - 1).Interior.Color <> xlNone Then
wsA.Cells(rgA.Row + r - 1, flagCol).Value = "差分あり"
End If
Next
End Sub
- ポイント
- 色付け後にフラグ列を作り「差分あり」と記録。
- フィルタで差分行だけ抽出可能。
例題で練習
'例1：同じ位置のセルを比較して黄色に塗る
Sub Example_ColorBasic()
ColorDiff_Basic
End Sub
'例2：キー突合で新規・削除・変更を色分け
Sub Example_ColorByKey()
ColorDiff_ByKey
End Sub
'例3：色付け後にフラグ列を追加
Sub Example_ColorAddFlag()
ColorDiff_AddFlag
End Sub
よくある落とし穴と対策
- キー表記揺れで誤判定
- 対策: Trim＋UCaseで正規化。必要なら半角化・記号除去も。
- 数値が文字列で比較ズレ
- 対策: Val→CDblで数値化して比較。
- 色が既存の書式とぶつかる
- 対策: 差分用の色パレットを決める。必要なら別列にフラグを残す。