エクセルでで○段ずつ集計する方法を教えてください。

質問

エクセルで伝票印刷をするため、３段づつ集計する方法がありましたら教えてください。
たとえば、下記のｓｈｅｅｔ１のＤＢをｓｈｅｅｔ２へ集計する感じです。宜しくお願いします。

sheet１（ＤＢ）
　　　Ａ　　 　 　Ｂ　　　　Ｃ　　　 Ｄ　　
　　購入者　 　品名　数量　 単価
１　 ああ 　　かか　 ３　　１００円
２　 ああ　　　　きき　 ６　　１５０円　
３　 ああ　　　　くく　 ８　　１００円
４　 ああ　　　　けけ　 ３　　２５０円
５　 いい　　　　きき　 ４　　１５０円
６　 いい　　　　けけ　 ６　　２５０円
７　 うう　　　　くく　 ８　　１００円
８　 ええ　　　　きき　 ６　　１５０円

sheet２（sheet１を３段づつ集計）
　　　Ａ　　 Ｂ　　Ｃ　　 Ｄ　　
　　購入者　 品名　数量　 単価
１　 ああ 　　 かか　 ３　　１００円
２　 　　　　　　きき　 ６　　１５０円　
３　 　　　　　　くく　 ８　　１００円
４　 小計　　　　　１７　 ２３００円　
５　 ああ　　　　けけ　 ３　　２５０円
６
７
８　 小計　　　　　　　 ３　　２５０円
９　 いい　　　　きき　 ４　　１５０円
１０ いい　　　　けけ　 ６　　２５０円
・　　・　　　　　・　　・　　　・
・　　・　　　　　・　　・　　　・
・　　・　　　　　・　　・　　　・

回答No.4

pauNed · ベストアンサー

こんにちは。
一例です。地道にやるという方針なら、それほど難しくはありません。

Dim ck As String '改ページチェック文字を格納する変数
Dim i　As Long　 '行Loopカウント用
Dim n　As Long　 '挿入行カウント用

With Sheets("Sheet2") 'Sheet2に対する処理
　　i = 2　　'データが始まる行。（項目行以外）
　　n = 3　　'挿入行が最大３行なので。
　　ck = .Cells(i, 1).Value　　'まずA2セルの値を最初のチェック文字とする。

　　Do
　　　　i = i + 1
　　　　'A3セルから下にLoopしながら、セルの値がチェック文字と違うor３行ごとという条件で行挿入。
　　　　If (.Cells(i, 1).Value <> ck) Or (n = 1) Then
　　　　　　.Rows(i).Resize(n).Insert
　　　　　　'行挿入により、Loop中のセル行が変わったため、挿入した行数を加算。
　　　　　　i = i + n
　　　　　　'１つ上の行に計算式を入れる。
　　　　　　With .Cells(i - 1, 1)
　　　　　　　　.Value = "小計"
　　　　　　　　.Offset(, 2).Resize(, 2).FormulaR1C1 = "=sum(r[-3]c:r[-1]c)"
　　　　　　End With
　　　　　　'挿入最大行数に再設定。
　　　　　　n = 3
　　　　　　'比較文字を再設定。
　　　　　　ck = .Cells(i, 1).Value
　　　　Else
　　　　　　'挿入条件に合わなかったら、A列セル値をクリア。
　　　　　　.Cells(i, 1).ClearContents
　　　　　　'挿入行数をカウントダウン。
　　　　　　n = n - 1
　　　　End If
　　Loop Until Len(ck) = 0

End With

Sheet1からSheet2にデータをコピーした後に実行しなければなりません。
必要であればコピーするコードを自分で書き加えるなど、工夫してみてください。

A列をLoopしながらデータの切れ目をチェックし、行挿入と同時に数式をセットします。
自分でメンテナンスできないと意味がないので、
VBEの[ローカルウィンドウ]を表示させて、
変数の中味を確認しながら[F8]キーでワンステップずつ実行し、
コードの理解に努めてください。

データ量はどれくらいなのでしょうね。
何千件ともなれば、配列を使ったほうが効率が良いのですが、
とりあえず理解できるところから始めてみましょう。

回答No.3

mitarashi

#2の補足です
エラーが出るのは、ユーザー定義型の配列を渡そうとするところでしょうか？
Sub outputブロック(ブロックデータ() As 販売データ)
とすると、
Dim ブロックデータ() As 販売データ
をモジュールレベルで宣言（Dim outputRow As Longの後ろに）して、
Sub outputブロック()
と、引数無しにして、当然サブルーチンを呼ぶところも引数なしにしてみたらどうでしょうか。
If i > 1 Then Call outputブロック()
当方、2003を試せるインフラが無いため、検証はできません。

回答No.2

mitarashi

面白そうなので作成してみました。普段は変数名に全角文字は使用しないのですが、分かり易くするためにあえて使ってあります。Excel2000のコードです。2002以上（特に2007）で動くかどうかは分かりません。
とりあえず動けば良いというコードですので、識者の方々、突っ込まないでください。
Option Explicit

Type 販売データ
購入者 As String
品名 As String
数量 As Long
単価 As Long
数量※単価 As Long
End Type

Dim outputRow As Long

Sub test()
Dim ブロックデータ() As 販売データ
Dim i As Long, j As Long
Dim last購入者 As String

j = 1
last購入者 = ""
outputRow = 1
For i = 1 To Application.WorksheetFunction.CountA(Sheets("Sheet1").Range("$a:$a"))
If j = 4 Or Cells(i, 1).Value <> last購入者 Then
If i > 1 Then Call outputブロック(ブロックデータ())
ReDim ブロックデータ(1 To 3) As 販売データ
j = 1
End If
With ブロックデータ(j)
.購入者 = Sheets("Sheet1").Cells(i, 1).Value
.品名 = Sheets("Sheet1").Cells(i, 2).Value
.数量 = Sheets("Sheet1").Cells(i, 3).Value
.単価 = Sheets("Sheet1").Cells(i, 4).Value
.数量※単価 = .単価 * .数量
last購入者 = .購入者
End With
j = j + 1
Next i
End Sub

Sub outputブロック(ブロックデータ() As 販売データ)
Dim j As Long
Dim 数量合計 As Long, 数量※単価合計 As Long

For j = 1 To 3
With ブロックデータ(j)
Sheets("Sheet2").Cells(outputRow, 1).Value = .購入者
Sheets("Sheet2").Cells(outputRow, 2).Value = .品名
If .数量 <> 0 Then Sheets(2).Cells(outputRow, 3).Value = .数量
If .単価 <> 0 Then Sheets(2).Cells(outputRow, 4).Value = .単価
数量合計 = 数量合計 + .数量
数量※単価合計 = 数量※単価合計 + .単価 * .数量
End With
outputRow = outputRow + 1
Next j
Sheets("Sheet2").Cells(outputRow, 1).Value = "小計"
Sheets("Sheet2").Cells(outputRow, 3).Value = 数量合計
Sheets("Sheet2").Cells(outputRow, 4).Value = 数量※単価合計
outputRow = outputRow + 1
End Sub

実行例です

ああ　　　　かか　　　　3　　　　100
ああ　　　　きき　　　　6　　　　250
ああ　　　　くく　　　　8　　　　100
小計　　　　　　　　　　17　　　　2600
ああ　　　　けけ　　　　3　　　　250

小計　　　　　　　　　　3　　　　750
いい　　　　きき　　　　4　　　　150
いい　　　　けけ　　　　6　　　　250

小計　　　　　　　　　　10　　　2100
うう　　　　くく　　　　8　　　　100

小計　　　　　　　　　　8　　　　800
小計が質問と合わないのですが、考え方がちがうのかな？
配列を引数にするやり方を忘れていて、手こずりました。
コードの解説はご容赦下さい。

お礼

返事が遅くなって申し訳ありません。
試したところ、excel2003、2007でパブリックユーザー定義エラーがでて動かなそうです。
この事例は長年の懸案でもあります。なんとか解決したいものですが・・・皆様のお力が頼りです。よろしくお願いします。

回答No.1

imogasi

エクセルでは（データ数に左右される）不定位置に（行番号に）数の小計を挿入するのは、非常に難しい（式が難しくなる）。エクセルの経験が少なくそういう経験をしてないのだろう。
関数では行挿入はできないから、式の上では全面的組み換えの考えになる。
関数以外で、ＶＢＡでなら、まだプログラムロジックが組みやすい。
ＶＢＡも経験ないのだろうから、困ったことだ。小計を別列にする，かつ上から詰めてというのは我慢できないかな。それでも難しそうだが。

お礼

回答ありがとうございます。
やはりＶＢＡを組まないと無理なのでしょうか・・・
もし、出来るようなら教えていただけるとありがたいのですが。
宜しくお願いします。