2008年3月24日月曜日

重複行の削除

Sub deleteLow()
Dim lastrow As Integer

Dim i As Long
Dim cnt As Long

lastrow = Range("A65536").End(xlUp).Row
cnt = 1

For i = lastrow To 2 Step -1

If Cells(i, 1).Value = Cells(i - 1, 1).Value And _
Cells(i, 2).Value = Cells(i - 1, 2).Value And _
Cells(i, 3).Value = Cells(i - 1, 3).Value And _
Cells(i, 4).Value = Cells(i - 1, 4).Value And _
Cells(i, 5).Value = Cells(i - 1, 5).Value _
Then
Cells(i, 1).EntireRow.Delete Shift:=xlUp
cnt = cnt + 1

Else

Cells(i, 6) = cnt
cnt = 1

End If

Next i

End Sub

0 件のコメント: