|
こんにちは
データを並び替えて良いのなら
こんな感じです。(データは1行目より)
Sub Macro1()
Dim i As Long
Application.ScreenUpdating = False
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
For i = Range("A65536").End(xlUp).Row To 2 Step -1
If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
Cells(i, 1).EntireRow.Copy
Cells(i - 1, 1).PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd
Cells(i, 1).EntireRow.Delete
End If
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
|
|