|
お世話になります。
以下のような表があり、A列の各分類の間に小計のための空行をいれたいと思っています。
分類 価格
AAA 100
AAA 100
BBB 300
CCC 500
CCC 500
CCC 500
DDD 250
そこで以下のようなマクロを組んだのですがうまく動作してくれず
ループに陥ってしまうようなのです。
また分類には稀に1行だけのものもあり、End(xlup)ではうまく動作しない気がしています。
なんとかマクロを完成させたいのでアドバイスよろしくお願いします。
-------以下ソース---------------
Sub 小計作成()
Un1 = Range("A2")
Dim UnitRow As Range
For Each UnitCrm In Range(Range("A1"), Range("A65536").End(xlUp))
If UnitCrm.Offset(1) = Un1 Then
Else:
挿入行 = UnitCrm.Row + 1
Rows(挿入行).Insert
Exit For
End If
Next
Do Until i = 20
Set Un2 = Range("A65536").End(xlUp).End(xlUp)
Dim UnitRow2 As Range
For Each UnitCrm2 In Range(Un2, Range("A65536").End(xlUp))
If UnitCrm2.Offset(1) = Un2 Then
ElseIf UnitCrm2.Offset(1) = "" Then
Else:
挿入行2 = UnitCrm2.Row + 1
Rows(挿入行2).Insert
i = i + 1
Exit For
End If
Next
Loop
End Sub
-------------ここまで-----------------
※分類は多くても20種類くらいなので、20回ループしたら止まるようにしているは ずですがESC押すまでとまらないような感じです(汗)
|
|