CompareSheets

' 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.Rows.Count
    lastRow2 = ws2.UsedRange.Rows.Count
    lastCol1 = ws1.UsedRange.Columns.Count
    lastCol2 = ws2.UsedRange.Columns.Count

    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