Sub 重複判定()
Dim 行番号 As Long
Dim 最終行 As Long
With ActiveSheet
'A列の最終行を取得
最終行 = .Cells(Rows.Count, "A").End(xlUp).Row
'A列の最終行まで繰り返し
For 行番号 = 2 To 最終行
'B列の番号の重複確認
If WorksheetFunction.CountIf(.Range("B:B"), .Cells(行番号, "B")) > 1 Then
'1を超える件数でデータ重複をC列に書き込み
.Cells(行番号, "C") = "データ重複"
End If
Next 行番号
End With
End Sub