Sub KEY列の比較とリスト化()
Dim ws1 As Worksheet, ws2 As Worksheet, wsResult As Worksheet
Dim cell1 As Range, cell2 As Range
Dim keyColumn As Integer
Dim notFoundInSheet1 As String, notFoundInSheet2 As String
Dim resultRow, resultRow2 As Long
' Sheet1とSheet2を指定
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
' 新しいシートを作成
Set wsResult = Worksheets.Add
wsResult.Name = "DifferenceList"
' KEY列の列番号を指定（例: A列なら1）
keyColumn = 3
' Sheet1に存在しない値を格納する変数
notFoundInSheet1 = ""
' Sheet2に存在しない値を格納する変数
notFoundInSheet2 = ""
' 結果シートのヘッダーを設定
wsResult.Range("A1").Value = "Sheet1 にのみ存在"
wsResult.Range("B1").Value = "Sheet2 にのみ存在"
' 結果シートの行数
resultRow = 2
resultRow2 = 2
' Sheet2の各セルについてループ
For Each cell2 In ws2.UsedRange.Columns(keyColumn).Cells
Dim foundInSheet1 As Boolean
foundInSheet1 = False
' Sheet1で同じKEYを探す
For Each cell1 In ws1.UsedRange.Columns(keyColumn).Cells
If cell1.Value = cell2.Value Then
foundInSheet1 = True
Exit For
End If
Next cell1
' Sheet1に存在しない場合は差異を赤でハイライト-------------
If Not foundInSheet1 Then
cell2.Interior.Color = RGB(255, 0, 0) ' 赤でハイライト
' 結果シートに追加
wsResult.Cells(resultRow, 2).Value = cell2.Value
resultRow = resultRow + 1
End If
Next cell2
' Sheet1に存在しない値をチェック
For Each cell1 In ws1.UsedRange.Columns(keyColumn).Cells
Dim foundInSheet2 As Boolean
foundInSheet2 = False
' Sheet2で同じKEYを探す
For Each cell2 In ws2.UsedRange.Columns(keyColumn).Cells
If cell1.Value = cell2.Value Then
foundInSheet2 = True
Exit For
End If
Next cell2
' Sheet2にも存在しない場合は差異を赤でハイライト-------------
If Not foundInSheet2 Then
cell1.Interior.Color = RGB(255, 0, 0) ' 赤でハイライト
' 結果シートに追加
wsResult.Cells(resultRow2, 1).Value = cell1.Value
resultRow2 = resultRow2 + 1
End If
Next cell1
' 結果を表示
If resultRow > 2 Then
MsgBox "Sheet1とSheet2の差異があります。" & vbLf & "リストを確認してください。", vbInformation, "比較結果"
Else
MsgBox "Sheet1とSheet2は同じKEYを持っています。", vbInformation, "比較結果"
' 不要な結果シートを削除
Application.DisplayAlerts = False
wsResult.Delete
Application.DisplayAlerts = True
End If
End Sub
KEY列の比較とリスト化
