【EXCEL VBA（マクロ）】縦（行）ループして、重複しているデータの隣に「重複」と表記する

選択範囲の重複チェック⇒重複データは隣のセルに「重複」と表示

これは、ユーザーにセル範囲を選択させ、選択された範囲内の重複する値をチェックし、隣のセルに “重複” と表示するエクセルマクロです。

Sub 選択範囲の重複チェック()
Dim rng As Range, r As Range, chkVal As Integer
Set rng = Range(Selection.Address)

On Error Resume Next
Set rng = Application.InputBox(prompt:="セル範囲を選択", Type:=8)
On Error GoTo 0
rng.Select

For Each r In rng
    chkVal = Application.CountIf(rng, r)
        If chkVal > 1 Then
            r.Offset(0, 1).Value = "重複"
        Else
            r.Offset(0, 1).Value = ""
        End If
Next r

MsgBox "完了"
End Sub

解説

Set rng = Application.InputBox(prompt:="セル範囲を選択", Type:=8)：ユーザーにセル範囲を選択するように促すメッセージボックスが表示されます。選択された範囲は、rng変数に設定されます。
On Error GoTo 0：エラー処理を無効にします。
rng.Select：選択されたセル範囲を選択状態にします。
For Each r In rng：選択された範囲内の各セルに対して、以下のコードが実行されます。
chkVal = Application.CountIf(rng, r)： Application.CountIf関数を使用して、選択された範囲内で、現在のセル(r)と同じ値を持つセルの数を数えます。この値は、chkVal変数に設定されます。
If chkVal > 1 Then：現在のセル(r)と同じ値を持つセルが複数ある場合は、以下のコードが実行されます。
r.Offset(0, 1).Value = "重複"：現在のセル(r)の隣のセルに、”重複”というテキストを設定します。
Else：現在のセル(r)と同じ値を持つセルが1つしかない場合は、以下のコードが実行されます。
r.Offset(0, 1).Value = ""：現在のセル(r)の隣のセルに、何も設定しません。

以上のコードを使用すると、選択された範囲内の重複する値を簡単にチェックし、重複する値がある場合は隣のセルに “重複” と表示することができます。

二つの項目（二語）で重複チェック

このVBAコードは、A列とD列の2つの項目（2つの単語）で重複をチェックし、重複がある場合には行の背景色を変更し、隣のセルに “重複” というテキストを表示するコードです。

Sub 重複行のチェック_B列に重複と表示()

Range("A1").Select
ActiveCell.Next.EntireColumn.Insert

Dim maxRow As Long
maxRow = Cells(Rows.Count, 1).End(xlUp).Row
  

'データ行数分 重複削除
Dim i As Long
  
  For i = 2 To maxRow

   'If Cells(I - 1, 3) = Cells(I, 3) Then
    If Cells(i - 1, 1).Value & Cells(i - 1, 4).Value = Cells(i, 1).Value & Cells(i, 4).Value Then
        Rows(i).Interior.Color = RGB(204, 255, 255)
        Cells(i, "B") = "重複"
    End If
  Next i
  
'背景色で抽出
ActiveSheet.Cells.AutoFilter Field:=1, Criteria1:=RGB(204, _
255, 255), Operator:=xlFilterCellColor

MsgBox "完了"
End Sub

解説

Range("A1").Select： A1セルを選択します。
ActiveCell.Next.EntireColumn.Insert：選択したセルの隣に新しい列を挿入します。
Dim maxRow As Long maxRow = Cells(Rows.Count, 1).End(xlUp).Row：ワークシート内の最後の行の行番号を取得します。maxRow変数に格納されます。
For i = 2 To maxRow： 2行目から最後の行まで、以下のコードが実行されます。
If Cells(i - 1, 1).Value & Cells(i - 1, 4).Value = Cells(i, 1).Value & Cells(i, 4).Value Then： A列とD列の2つの項目が両方とも前の行と同じ場合には、以下のコードが実行されます。
Rows(i).Interior.Color = RGB(204, 255, 255)：重複している行の背景色を変更します。
Cells(i, "B") = "重複"：重複している行の隣のセルに “重複” というテキストを表示します。
ActiveSheet.Cells.AutoFilter Field:=1, Criteria1:=RGB(204, 255, 255), Operator:=xlFilterCellColor：重複している行の背景色でフィルターをかけます。