EXCELでマクロを使って、小計、合計の出し方

質問

１．部の中にそれぞれ、営業１課、営業２課、…があり、社員と売上金額が表示されている下記のようなデータがあります。
部、課、社員の数は、実際はもっとたくさんあり、それぞれの件数は、毎月変化します。
マクロを使って、課毎計、部毎計、総合計を出す方法を教えて下さい。
試しに作りましたら、下記のような結果になり、うまくいきません。
元データ
部 課 社員 金額
A 営業１課 a 10
A 営業１課 b 20
A 営業１課 c 30
A 営業２課 d 40
A 営業２課 e 50
A 営業２課 f 60
Ｂ 営業１課 ｇ 70
Ｂ 営業１課 h 80
Ｂ 営業１課 I 90
Ｂ 営業２課 j 100
Ｂ 営業２課 k 110
Ｂ 営業２課 l 120

実行結果
　 　 　　　　　 × 　 正解
部 課 社員 金額 　 金額
A 営業１課 a 10 　 10
A 営業１課 b 20 　 20
A 営業１課 c 30 　 30
　 営業１課　計　 60 　 60
A 営業２課 d 40 　 40
A 営業２課 e 50 　 50
A 営業２課 f 60 　 60
　 営業２課　計 210 　 150
A　合計 　 　 110 　 210
Ｂ 営業１課 ｇ 70 　 70
Ｂ 営業１課 h 80 　 80
Ｂ 営業１課 I 90 　 90
　 営業１課　計 240 　 240
Ｂ 営業２課 j 100 　 100
Ｂ 営業２課 k 110 　 110
Ｂ 営業２課 l 120 　 120
　 営業２課　計 570 　 330
Ｂ　合計 　 　 230 　 570
総合計 　 　 780 　 780

Sub 合計計算()
Sheets("元").Select
Sheets("元").Copy Before:=Sheets(2)
Dim GYO1 As Long '部 グループの先頭行
Dim GYO2 As Long '部 グループの最終行
Dim GYO3 As Long '課グループの先頭行
Dim GYO4 As Long '課グループの最終行
Dim GYO As Long '小計、合計行
Dim strFORMULA As String
GYO = 2
'空白でない間、次の作業を繰り返す
Do While Cells(GYO, 1).Value <> ""
GYO1 = GYO
GYO = GYO + 1
'部が同じ間、次の作業を繰り返す
Do While Cells(GYO, 1).Value = Cells(GYO1, 1).Value
GYO = GYO + 1
'課が同じ間、次の作業を繰り返す
GYO3 = GYO
Do While Cells(GYO, 2).Value = Cells(GYO3, 2).Value
GYO = GYO + 1
Loop

'課計
GYO2 = GYO - 1
Rows(GYO).Insert
Cells(GYO, 2).Value = Cells(GYO3, 2).Value & "　計"
Cells(GYO, 4).FormulaR1C1 = "=SUBTOTAL(9,R" & GYO1 & "C:R" & GYO2 & "C)"
GYO = GYO + 1
Loop

'部計
GYO4 = GYO - 1
Rows(GYO).Insert
Cells(GYO, 1).Value = Cells(GYO1, 1).Value & "　合計"
Cells(GYO, 4).FormulaR1C1 = "=SUBTOTAL(9,R" & GYO3 & "C:R" & GYO4 & "C)"
GYO = GYO + 1
Loop

' 総合計
Cells(GYO, 1).Value = "総合計"
Cells(GYO, 4).FormulaR1C1 = "=SUBTOTAL(9,R1C:R" & GYO2 & "C)"
Range("A1").Select
End Sub
２．尚、この質問のように表形式のデータを間隔をあけて原稿を作成しても確認画面になると、間隔が詰まります。間隔が詰まらない方法も教えて下さい。

回答No.4

Wendy02 · ベストアンサー

こんにちは。

>最初のレイアウトのようにそれぞれの部、課毎の下に計を出せないでしょうか？

#2 さんのご指摘のように、[ピボットテーブル]や、データの中の[集計]を使ったほうが簡単だと思います。

それと、「実行結果」というもののレイアウトが良く理解できていません。なぜ、計算データを二重にする必要があるのか分かりません。

この種のマクロは、素人もベテランの人も、内容はほとんど変わりません。有志の方で、構わない、作りますという方は、ここのカテゴリでも、他の掲示板でもいますが、なるべく、個人のマクロの勉強の過程の中で開発していくようにお願いしたいと思っています。ただ、あまり実務に直結したマクロの勉強には、ほとんどならないとは思います。私も、今回、たまたま別の方の質問の余韻が残っていたので、#1に書いたまでで、本来、以下のようなマクロは現在は掲示板にはほとんど書いていません。

一応、書いた責任上は、ここにコードを出しておきます。

'標準モジュール

Sub SortEnter()
　　Dim i As Long
　　Dim EndRow As Long
　　Dim RowDiff As Long

　　Application.ScreenUpdating = False
　　'ソート
　　With Range("A1").CurrentRegion
　　　　.Sort _
　　　　Key1:=.Range("A2"), Order1:=xlAscending, _
　　　　Key2:=.Range("B2"), Order2:=xlAscending, _
　　　　Header:=xlYes, _
　　　　OrderCustom:=1, MatchCase:=False, _
　　　　Orientation:=xlTopToBottom, SortMethod:=xlPinYin, _
　　　　DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
　　　　RowDiff = .Cells(.Cells.Count).Row - .Rows.Count
　　　　EndRow = .Cells(.Cells.Count).Row
　　　　For i = .Rows.Count To 3 Step -1
　　　　'部
　　　　　　If StrComp(Trim(.Cells(i, 1).Value), Trim(.Cells(i - 1, 1).Value), 1) <> 0 Then
　　　　　　　　.Cells(i, 1).Resize(2).EntireRow.Insert
　　　　　　　　i = i - 2
　　　　　　End If
　　　　　　'課
　　　　　　If StrComp(Trim(.Cells(i, 2).Value), Trim(.Cells(i - 1, 2).Value), 1) <> 0 Then
　　　　　　　　.Cells(i, 1).EntireRow.Insert
　　　　　　　　i = i - 1
　　　　　　End If
　　　　Next i
　　End With
　　Call FormulaSumEnter
　　Application.ScreenUpdating = True
End Sub
Private Sub FormulaSumEnter()
　　'数式を入れるマクロ
　　Dim FstRow As Long
　　Dim FstRow1 As Long
　　Dim FstRow2 As Long
　　Dim TotalRow As Long
　　Dim i As Long
　　TotalRow = Range("A65536").End(xlUp).Row + 2 '合計欄の2行を加える
　　FstRow = 2 '計算の最初の行
　　FstRow1 = FstRow
　　FstRow2 = FstRow

　　For i = 2 To TotalRow
　　　　If Cells(i, 2).Value = "" Then
　　　　　　Cells(i, 4).FormulaLocal = "=SUBTOTAL(9,R[" & CStr(FstRow1 - i) & _
　　　　　　"]C:R[-1]C)"
　　　　　　Cells(i, 2).Value = Cells(i - 1, 2).Value & " 計"
　　　　　　FstRow1 = i + 1

　　　　　　If Cells(i + 1, 2).Value = "" Then
　　　　　　　　Cells(i + 1, 4).FormulaLocal = "=SUBTOTAL(9,R[" & CStr(FstRow2 - i - 1) & "]C:R[-2]C)"
　　　　　　　　Cells(i + 1, 1).Value = Cells(i - 2, 1).Value
　　　　　　　　Cells(i + 1, 2).Value = "合　計"
　　　　　　　　FstRow2 = i
　　　　　　End If
　　　　End If
　　Next i
　　Cells(i, 1).Value = "総 合 計"
　　Cells(i, 4).FormulaLocal = "=SUBTOTAL(9,R[" & CStr(FstRow - i + 1) & "]C:R[-2]C)"
End Sub

お礼

質問のため、簡単な表にし、これなら[ピボットテーブル]や、データの中の[集計]を使ったほうが簡単なのですが、実際はもっと複雑な表です。[ピボットテーブル]ですと、余分なものまで表示されてしまいみにくくなるため、EXCELのマクロを使おうと思いました。
作成していただいたコードの
最後から２行目は、[" & CStr(FstRow - i + 1) & "]
となっていますが、、[" & CStr(FstRow - i ) & "]
ではないでしょうか？
これで実行すると、うまくいきました。本当に詳しい解説ありがとうございました。

補足

[ピボットテーブル]や、データの中の[集計]を実行する時にマクロの記録をしますと、コードがわかりますが、Wendy02さんの書かれた上のようなコードは、すべて手入力されて作成されるのですか？
解読しようとしたのですが、下から１０行目の
= "=SUBTOTAL(9,R[" & CStr(FstRow2 - i - 1) & "]C:R[-2]C)"
の部分の意味がよくわかりません。この部分は、どのようにして作成されるのですか？教えて下さい。

回答No.5

KenKen_SP

> 最初のレイアウトのものをマクロで作成したいのです。

行の列：　[部][課][人]
集計欄：　[金額]

で、出力レイアウトはかなり近いものになりますが。。

マクロで実現されたいようですが、この操作を記録すると、
参考になるコードが得られると思います。

あとは、それにデータ件数が変動した場合の処理を付け加える
だけでかなり実用的になると思いますよ。

一案ですが。

お礼

かなり近いものができました。
ありがとうございました。

回答No.3

imogasi

質問者のほとんどは、自分の既に考え付いたやり方（ロジック）コードを修正箇所を教えてくれというのが多い。
しかし洗練されていないのが多い。
ーー
基本は、ピヴォトテーブルのように便利な、他人（プロ）の組んだソフトを使うことです。
他にもソートして、「データ」「集計」など使えそう
この集計する程度のことで、自作していたら、勉強にはなるが、時間がもったいないだけ。
ーー
しかしあえて、私が回答で何度も書いたが、ソート法という、昔ながらの方法を書きます。先達の知恵で、味わい深い点があると思うので、参考にしてください。
（１）シートをコピーをとり、以下はコピー先で処理
（２）部＋課（キーという）でソート（＋の意味わかりますか）
（３）第１（レコード）行目のデータのキーを、変数を設けて保存し、売上を足しこむ変数に足しこみ
（４）次のレコード（行）を対象に、直前レコードとキー部分が変わったか、比較する。コントロールブレイクの検出という。
（５）変わらなければ、売上を足すだけー＞（４）へ行って繰り返し。
（６）変わったら、直前のキーと今までの合計を書き出す。
　　合計は０（ご破算）に
　　キーは今の行のものに改める
　　合計（上記で０にした）に今の行のものを足す。
　　－＞（４）へ行って繰り返し
（６）最後が来たら、今溜まっているキーと合計を書き出し。
ーー
以上は課（小）合計を説明したが、部合計用の変数も用意し、（４）で課とあわせて、部が変わったかチェックし、変わるごとに、溜めた部と合計を書き出し、かつ合計を０にする。
課が変わるごとに、課合計を部合計に加える方法でもよい。

お礼

詳しくて、わかりやすいご説明ありがとうございました。

回答No.2

KenKen_SP

ピボットテーブルでできますよ。レイアウトは例えば、

列の単に [人]
行の欄に [部][課]
集計欄に [金額]

をそれぞれドロップし、OKをクリックするだけです。

補足

ご回答ありがとうございました。
ピボットテーブルだと、結果のみの集計になってしまいますし、
行、列、集計欄に項目を手入力でドロップする必要があります。
最初のレイアウトのものをマクロで作成したいのです。

回答No.1

Wendy02

こんばんは。

最初に、
>間隔が詰まらない方法も教えて下さい。
確か、全角空白でも縮まってしまいますので、「.（コンマ）」を入れるのですが、ただ、コードの場合は、エラーが発生してしまいます。だから、「'.」となるのですが、他のみなさんはどうかしりませんが、私は、テキストエディタ上で、レイアウトをもう一度、整えますので、あまり気になさらずによいです。

ところで、前回のものをあわせて、マクロでずいぶん難しいことをされるなって思います。ワークシートを扱うマクロは、本当に難しいのです。だから、なるべく、こういうのは、無理にでも関数で処理する方向性のほうがよいと思います。実務では、私個人としては、本当に、以下のようなマクロを書くかというと、よほど困らなければ、手作業でしてしまいます。

なお、ご質問ですが、並べ替えやレイアウト自体をいじっても、

課毎計、部毎計、総合計

ということは出来ないように思います。

単に、ユニークな部、課をはじき出しておいて、それでもって、SUMIF で出すのがよいのですが、以下のような方法もあるというひとつの例です。今回は、テキスト比較モードになっていますので、全角・半角などのブレに関しては、ひとまとめにしてくれます。

'標準モジュール用

Sub SubTotalMacro()
　　Dim dicBu As Object
　　Dim dicKa As Object
　　Dim Rng As Range
　　Dim i As Long
　　Dim j As Long
　　Dim k As Long

　　Set dicBu = CreateObject("Scripting.Dictionary")
　　Set dicKa = CreateObject("Scripting.Dictionary")
　　dicBu.CompareMode = 1 'テキスト比較モード
　　dicKa.CompareMode = 1 'テキスト比較モード

　　'集計データの左端
　　Set Rng = Range("A2", Range("A65536").End(xlUp))

　　Application.ScreenUpdating = False
　　For i = 1 To Rng.Rows.Count
　　　　If Rng(i, 4).Value <> "" Then
　　　　　　If dicBu.Exists(Rng(i, 1).Value) = False Then
　　　　　　　　dicBu.Add Rng(i, 1).Value, Rng(i, 4)
　　　　　　Else
　　　　　　　　dicBu(Rng(i, 1).Value) = dicBu(Rng(i, 1).Value) + Rng(i, 4)
　　　　　　End If

　　　　　　If dicKa.Exists(Rng(i, 2).Value) = False Then
　　　　　　　　dicKa.Add Rng(i, 2).Value, Rng(i, 4)
　　　　　　Else
　　　　　　　　dicKa(Rng(i, 2).Value) = dicKa(Rng(i, 2).Value) + Rng(i, 4)
　　　　　　End If
　　　　End If
　　Next i
　　j = dicBu.Count
　　k = dicKa.Count
　　'集計結果
　　i = i + 1
　　Cells(i + 1, 2).Value = "部別集計"
　　i = i + 1
　　Cells(i + 1, 3).Resize(j).Value = WorksheetFunction.Transpose(dicBu.Keys)
　　Cells(i + j + 1, 2).Value = "課別集計"
　　Cells(i + j + 2, 3).Resize(k).Value = WorksheetFunction.Transpose(dicKa.Keys)

　　Cells(i + 1, 4).Resize(j).Value = WorksheetFunction.Transpose(dicBu.Items)
　　Cells(i + j + 2, 4).Resize(k).Value = WorksheetFunction.Transpose(dicKa.Items)
　　Cells(i + j + k + 2, 2).Value = "総 計"
　　Cells(i + j + k + 2, 4).Value = WorksheetFunction.Sum(dicBu.Items)

　　Application.ScreenUpdating = True

　　Set Rng = Nothing
　　Set dicBu = Nothing
　　Set dicKa = Nothing
End Sub

お礼

丁寧なご回答ありがとうございました。

補足

ご回答ありがとうございました。
マクロよりも関数で処理する方向性のほうがよいとのことで、
SUMIFで作成しますと、できました。ただ、この場合、何回も操作が必要で、合計が元の表の下に集計されてしまいます。
やはり、関数ではなく、マクロで
最初のレイアウトのようにそれぞれの部、課毎の下に計を出せないでしょうか？課小計、部合計を出してから、それぞれその結果を０にする設定が必要だと思うのですが、この設定場所と方法が分かりません。
またＡ部の営業１課、営業２課とＢ部の営業１課、営業２課は、別の課とみなします。