|
申し訳ございません。
色々なパターンでの検証が足りませんでした。
kobasanさんフォローありがとうございました。
で、一応修正してみました。(まだ、検証が足りないかも...。)
Sub 一つづつ比較()
Dim CEL As Range,savad As String
Application.ScreenUpdating = False
Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
savad = "B2" 'データ部先頭
For Each CEL In Range("A2", Range("A65535").End(xlUp))
If CEL.Value <> CEL.Offset(1).Value And _
CEL.Value <> "" Then
CEL.Offset(1).EntireRow.Insert
subad = Range(Range(savad), CEL.Offset(1).End(xlUp).Offset(, 1)).Address(0, 0)
CEL.Offset(1, 1).Formula = "=sum(" & subad & ")"
savad = CEL.Offset(2, 1).Address
End If
Next
Application.ScreenUpdating = True
MsgBox "終わりました。"
End Sub
|
|