4つの語句(4項目)一致の重複セルを行単位で削除
この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関数を使い、重複データを検索します。4つの項目とも同じデータが2つ以上ある場合は、2以上の数値を返します。
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列に「重複」というテキストを表示し、フォントの色を赤色に変更します。
コメント