重複を削除する。
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 iEnd Sub
A列の値に重複があるかどうか判定し、あった場合その行を削除する。
ループしながら削除するとくずれる?