並べ替え方法

一番易しいのはソート法だと思う。 質問も単価でソート済みと見えるが、品目＋単価（降順）でソートすると（品目の順序が質問と変わるがその点は後述） 品目 単価 個数 バナナ 150 30 バナナ 150 40 バナナ 140 50 みかん 50 30 みかん 50 20 みかん 40 40 りんご 100 50 りんご 100 60 りんご 90 80 ーーー 品目＋単価で修正キーを作る。 修正キーが変わるまで個数を足しこむ。 変わると小計を書き出すのだが、対応した行に出したいらしい（これも質問にははっきり書くこと）ので直前の行に合計を書き出す。 これの最終行までの繰り返し。 ーー 下請け的な質問に応ずるのは良くなく、ヒントだけにしようと思ったが、まあすぐにはわからないだろうと思って答えを書くよ。 ーーー Sub test01() d = Range("A65536").End(xlUp).Row 'MsgBox d s = String(20, " ") Mid(s, 1, Len(Cells(2, "A"))) = Cells(2, "A") Mid(s, 11, Len(Cells(2, "A"))) = Cells(2, "B") m = s t = Cells(2, "C") For i = 3 To d '--修正キーの作成 Mid(s, 1, Len(Cells(i, "A"))) = Cells(i, "A") Mid(s, 11, Len(Cells(i, "A"))) = Cells(i, "B") 'MsgBox s If s = m Then t = t + Cells(i, "C") Else 'MsgBox t '--合計書き出し Cells(i - 1, "E") = Cells(i - 1, "A") Cells(i - 1, "F") = Cells(i - 1, "B") Cells(i - 1, "G") = t '-- t = 0 t = t + Cells(i, "C") m = s End If Next i 'MsgBox t '--合計書き出し Cells(i - 1, "E") = Cells(i - 1, "A") Cells(i - 1, "F") = Cells(i - 1, "B") Cells(i - 1, "G") = t '-- End Sub ーー 結果 品目 単価 個数 バナナ 150 30 バナナ 150 40 バナナ 150 70 バナナ 140 50 バナナ 140 50 みかん 50 30 みかん 50 20 みかん 50 50 みかん 40 40 みかん 40 40 りんご 100 50 りんご 100 60 りんご 100 110 りんご 90 80 りんご 90 80 ーーーー 当初の元の順を保存する法 品目 単 価 個数 バナナ 150 30 2 バナナ 150 40 2 バナナ 140 50 2 みかん 50 30 5 みかん 50 20 5 みかん 40 40 5 りんご 100 50 8 りんご 100 60 8 りんご 90 80 8 Ｄ列はＤ２に=IF(COUNTIF($A$2:A2,A2)=1,ROW(),D1) と入れて、下方向に式を複写。 この列も含めてソート。 前列範囲指定して、最後にこの列を第１順位にしＢ、Ｃの列で並べ替え。 プログラムで出した結果部（合計部）もうまくいくと思うが。