重複削除マクロ

重複を削除する。

Sub 重複を削除()

　Dim LastRow As Long
　LastRow = Cells(Rows.Count, 1).End(xlUp).Row
　Dim i As Long
　Dim a As Long
　Dim c As Long '重複している数のカウント用

　For i = 2 To LastRow
　c = 0

　　'重複があるか調べる
　　For a = 2 To LastRow
　　　If Cells(i, 1) = Cells(a, 1) Then
　　　　c = c + 1
　　　Else
　　　End If
　　Next a

　　'重複を削除
　　If c > 1 Then
　　　With Range("A1").CurrentRegion
　　　　.AutoFilter field:=1, Criteria1:=Cells(i, 1)
　　　　.Offset(1, 0).EntireRow.Delete
　　　　.AutoFilter
　　　End With
　　End If

　Next i

End Sub

A列の値に重複があるかどうか判定し、あった場合その行を削除する。

ループしながら削除するとくずれる？