Sub 比較と記載()
Dim ws As Worksheet
Dim lastRow1, lastRow2 As Long
Dim aRange As Range, cRange As Range
Dim aValue As Variant, cValue As Variant
Dim bColumn As Range, dColumn As Range
Dim i As Long
' 対象のシートを設定
Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を変更する必要があるかもしれません
' 最終行を取得
lastRow1 = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
lastRow2 = ws.Cells(ws.Rows.Count, "c").End(xlUp).Row
' 比較対象の列を設定
Set aRange = ws.Range("A2:A" & lastRow1)
Set cRange = ws.Range("C2:C" & lastRow2)
' 結果を記載する列を設定
Set bColumn = ws.Range("B2:B" & lastRow1)
Set dColumn = ws.Range("D2:D" & lastRow2)
i = 1
' a列にしかない値をB列に記載
For Each aValue In aRange
If IsError(Application.Match(aValue, cRange, 0)) Then
' a列にしかない値をB列に記載
bColumn.Cells(i, 1).Value = "●"
End If
i = i + 1
Next aValue
' 初期化
i = 1
' c列にしかない値をD列に記載
For Each cValue In cRange
If IsError(Application.Match(cValue, aRange, 0)) Then
' c列にしかない値をD列に記載
dColumn.Cells(i, 1).Value = "●"
End If
i = i + 1
Next cValue
End Sub
