| 
    
     |  | こんにちは 
 データを並び替えて良いのなら
 こんな感じです。(データは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
 
 |  |