【マクロ・VBA】縦（行）ループして、重複したデータを含む行を削除する

VBA

2023.03.18

４つの語句（４項目）一致の重複セルを行単位で削除

このExcel VBAのコードは、指定された範囲内にある重複データを検出して削除するプログラムです。

Sub 重複データの削除()
  Dim i, lRow As Long
  Dim CK As Integer
  
  lRow = Cells(Rows.Count, "A").End(xlUp).Row
  
  For i = 2 To lRow
  
        If WorksheetFunction.CountIfs(Range("A2:A" & lRow), Range("A" & i), Range("B2:B" & lRow), Range("B" & i), _
                Range("C2:C" & lRow), Range("C" & i), Range("D2:D" & lRow), Range("D" & i)) > 1 Then
                'CountIFs関数を使い、重複データを検索します。４つの項目とも同じデータが２つ以上ある場合は、２以上の数値を返します。
                
                Cells(i, "E") = "重複"
                Cells(i, "E").Font.ColorIndex = 3
                
        End If
  Next i
  
  CK = MsgBox("データを削除しますか？", vbYesNo + vbQuestion, "確認")
  
  If CK = vbYes Then
        Range("A1:E" & lRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
    Else
        MsgBox "キャンセルしました"
  End If
  
  MsgBox "完了"
End Sub

解説

Forループは、指定された範囲の間でループを実行するためのキーワードです。ここでは、2から最終行までの間でループを実行します。

CountIFs関数を使用して、指定された範囲内にある重複データを検索します。CountIFs関数は、指定された条件に合致するセルの数を返す関数です。ここでは、A列、B列、C列、D列のすべての項目が同じ行が2つ以上ある場合に、条件に合致するセルの数が2以上となります。重複がある場合は、E列に「重複」というテキストを表示し、フォントの色を赤色に変更します。