📋

CompareSheets

シート管理

2つのシートを比較し、差分を出力する

2つのワークシートのデータを比較してVBAで差分を検出するマクロです。同じ位置のセルを1つずつ照合し、値が異なる箇所をハイライトしたり差分リストとして出力したりできます。更新前後のデータ比較、マスタデータの整合性チェック、複数担当者が編集したファイルのマージ前確認などに活用できます。大量データでも自動処理で効率的に差異を特定できます。内部では2つのRangeオブジェクトを同じ座標でループ比較し、値が一致しないセルをInterior.Colorで着色するかリストとして書き出す構成です。DeleteEmptySheetsやMergeWorkbooksのような統合作業の前段階で本マクロを実行しておくと、統合前にデータの矛盾を検知でき、誤ったデータでの統合を未然に防げます。目視での突合作業に比べて見落としがなく、数千行規模でも短時間で完了します。

📖 使い方

VBAエディタを開く（Alt + F11）
モジュールを挿入（挿入 > モジュール）
下記VBAコードをコピー&ペースト
ブック上で実行（Alt + F8 でマクロ選択）

💡 実行例：実行すると2つのシート名を入力し、差分が新しいシートに出力される

🎯 活用シーン

✓前月と今月の売上データの差分を自動検出してレポート作成
✓システムから取得したマスタデータと手入力データの照合チェック
✓複数担当者が別々に更新したファイルのマージ前の差異確認
✓システム移行前後で同じレポートのデータが一致しているかを自動検証したいとき
✓複数拠点から届いた同一フォーマットのデータに矛盾がないか、突合作業を自動化したいとき

💡 実装のヒント

▸UsedRangeでデータが存在する範囲だけを比較対象にできます
▸差分セルをInterior.Colorで着色すると視覚的に分かりやすくなります
▸文字列の大文字小文字を区別するかはStrComp関数で制御できます
▸セルの数式ではなく計算結果（Value）で比較するかコード自体（Formula）で比較するかは、目的に応じて明示的に選択してください。
▸大量データの比較は処理時間がかかるため、比較前にApplication.ScreenUpdatingをFalseに設定することをお勧めします。

💻 VBAコード

' CompareSheets
' -----------------
' Macro Name: CompareSheets
' Description: 2つのシートを比較し、差分を出力する
' Parameters: なし
' Returns: なし
' Usage: 実行すると2つのシート名を入力し、差分が新しいシートに出力される
' -----------------

Sub CompareSheets()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim outputWs As Worksheet
    Dim sheet1Name As String
    Dim sheet2Name As String
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim lastCol1 As Long
    Dim lastCol2 As Long
    Dim maxRow As Long
    Dim maxCol As Long
    Dim i As Long
    Dim j As Long
    Dim outputRow As Long
    Dim diffCount As Long

    On Error GoTo ErrorHandler

    sheet1Name = InputBox("比較する1つ目のシート名を入力:", "シート比較", ActiveSheet.Name)

    If sheet1Name = "" Then
        Exit Sub
    End If

    On Error Resume Next
    Set ws1 = Worksheets(sheet1Name)
    On Error GoTo ErrorHandler

    If ws1 Is Nothing Then
        MsgBox "「" & sheet1Name & "」は存在しません。", vbExclamation
        Exit Sub
    End If

    sheet2Name = InputBox("比較する2つ目のシート名を入力:", "シート比較", "")

    If sheet2Name = "" Then
        Exit Sub
    End If

    On Error Resume Next
    Set ws2 = Worksheets(sheet2Name)
    On Error GoTo ErrorHandler

    If ws2 Is Nothing Then
        MsgBox "「" & sheet2Name & "」は存在しません。", vbExclamation
        Exit Sub
    End If

    Set outputWs = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    outputWs.Name = "比較結果_" & Format(Now, "hhnnss")

    lastRow1 = ws1.UsedRange.Row + ws1.UsedRange.Rows.Count - 1
    lastRow2 = ws2.UsedRange.Row + ws2.UsedRange.Rows.Count - 1
    lastCol1 = ws1.UsedRange.Column + ws1.UsedRange.Columns.Count - 1
    lastCol2 = ws2.UsedRange.Column + ws2.UsedRange.Columns.Count - 1

    maxRow = Application.Max(lastRow1, lastRow2)
    maxCol = Application.Max(lastCol1, lastCol2)

    outputWs.Cells(1, 1).Value = "シート比較結果"
    outputWs.Cells(1, 1).Font.Bold = True
    outputWs.Cells(1, 1).Font.Size = 14
    outputWs.Cells(2, 1).Value = "比較対象: " & sheet1Name & " vs " & sheet2Name
    outputWs.Cells(3, 1).Value = "実行日時: " & Format(Now, "yyyy/mm/dd hh:nn:ss")

    outputRow = 5
    outputWs.Cells(outputRow, 1).Value = "行"
    outputWs.Cells(outputRow, 2).Value = "列"
    outputWs.Cells(outputRow, 3).Value = sheet1Name & "の値"
    outputWs.Cells(outputRow, 4).Value = sheet2Name & "の値"
    outputWs.Cells(outputRow, 1).Font.Bold = True
    outputWs.Cells(outputRow, 2).Font.Bold = True
    outputWs.Cells(outputRow, 3).Font.Bold = True
    outputWs.Cells(outputRow, 4).Font.Bold = True
    outputWs.Range(outputWs.Cells(outputRow, 1), outputWs.Cells(outputRow, 4)).Interior.Color = RGB(200, 200, 200)

    diffCount = 0
    outputRow = 6

    For i = 1 To maxRow
        For j = 1 To maxCol
            Dim val1 As Variant
            Dim val2 As Variant

            If i <= lastRow1 And j <= lastCol1 Then
                val1 = ws1.Cells(i, j).Value
            Else
                val1 = ""
            End If

            If i <= lastRow2 And j <= lastCol2 Then
                val2 = ws2.Cells(i, j).Value
            Else
                val2 = ""
            End If

            If CStr(val1) <> CStr(val2) Then
                outputWs.Cells(outputRow, 1).Value = i
                outputWs.Cells(outputRow, 2).Value = j
                outputWs.Cells(outputRow, 3).Value = val1
                outputWs.Cells(outputRow, 4).Value = val2
                outputWs.Cells(outputRow, 1).Interior.Color = RGB(255, 230, 230)
                outputWs.Cells(outputRow, 2).Interior.Color = RGB(255, 230, 230)
                outputWs.Cells(outputRow, 3).Interior.Color = RGB(255, 230, 230)
                outputWs.Cells(outputRow, 4).Interior.Color = RGB(255, 230, 230)
                diffCount = diffCount + 1
                outputRow = outputRow + 1
            End If
        Next j
    Next i

    If diffCount = 0 Then
        outputWs.Cells(outputRow, 1).Value = "差分なし"
        outputWs.Cells(outputRow, 1).Font.Color = RGB(0, 128, 0)
    Else
        outputWs.Cells(outputRow, 1).Value = "合計 " & diffCount & " 件の差分"
        outputWs.Cells(outputRow, 1).Font.Color = RGB(255, 0, 0)
    End If

    outputWs.Columns("A:D").AutoFit
    outputWs.Select

    MsgBox "シート比較が完了しました。" & vbCrLf & diffCount & "件の差分が見つかりました。", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub

🔗 同カテゴリの関連マクロ