小計の値だけを集計
ExcelはVBAを使っても使わなくても、小計の値だけを集計して別の表を作るのは少し大変です。
今回は２つ以上のキー（項目）での集計値を求める方法を『小計機能』『ピポットテーブル』『VBAで同一シート上で集計する』『VBAで別シートに集計する』の4つの方法で試してみます。他にも良い方法があればご連絡いただけると嬉しいです。
0.小計結果を抽出する
小計機能を使うと右表A列B列のように
行が飛んで～集計という文字が入り
とてもコピーしにくいです。
そこでこれをFG列のように（小計だけ）
コピー、変換するツールを紹介いたします。
上から4行目のshiftの数を変更すれば
元の列から何列右にずらすか変更できます。とりあえず結果を手っ取り早く別の表に貼り付けて使用したいときにお勧めです。
Sub 小計のみコピー()
Dim R1 As Range
Dim i, Shift, Max1 As Long
Shift = 5 'コピー先の列を何列ずらすか決める
With Range("A1").CurrentRegion
'見えている範囲の全ての行、列それぞれに対して処理を実行する
For Each R1 In .Resize(.Rows.Count).SpecialCells(xlCellTypeVisible).Rows
R1.Offset(0, Shift).Value = R1.Value
Next
End With
' " 集計" の文字を空白に置き換える
Max1 = Cells(Rows.Count, Shift + 1).End(xlUp).Row
For i = 1 To Max1
Cells(i, Shift + 1) = WorksheetFunction.Substitute(Cells(i, Shift + 1), " 集計", "")
Next
End Sub
1.合成キーを作成する
2つ以上のキー（項目）で集計するにはそのキーを合成する必要があります。合成そのものは『&』で可能ですが日付は数字形式に変換されてしまうのでtext関数で表示形式を揃えたほうが便利です。また数字形式でも桁の長さがそろっていない時もこの関数を使ったほうが見やすくなります。
いくつかの例をあげます。
ここではキーを見やすくするためにExcel関数で通しますが、VBAで処理する場合はFormatというメソッドを使用します。機能はこのような用途では同じです。紛らわしいですね。他にもExcelシート上の=today()がVBAでは Date()になるのも要注意です。
①データのリボンを選択する
②『小計』の機能を選択する
③『グループの基準(A)』を『合成キー』とする
『集計するフィールド(D)』を『金額』として『OK』を押す
Ｉ列を挿入する
Ｉ列の値をＪ列の１行上の値とする（黄色の色が同じ値になるようにする－Ｉ4のセルを"=J3"とする
Ｉ列を下までコピーする（～「集計」の文字が気にならない方はこの列挿入は必要ありません）
④アウトラインの番号（左端の□で囲まれた数字）２を選ぶ
| 金額を選択したならば、"Ctrl" キー を押しながら、Ｊ列を（同じ行数）選択する |
"Alt" キーを押しながら " ； "キーを押す
そのままの状態でコピーし、別のシートに貼り付ける
- 合成キーと金額の表が左記のようにできます（１行目は別途記入して下さい）
- Ｉ列を挿入して式を入寮する理由は、合成キーに～『集計』を表示させないためです。『集計』が気にならなければ不要です。
- 最後のAlt + ; を使用して必要な行だけコピーする方法はフィルターの掛かっている表の列間コピーにも応用できますが、操作がデリケートなので失敗すると間の行が全てコピーされてしまいます。
まとめ：手数が多くてあまりおすすめできませんが、小計付の明細表もあわせて必要という場合には
選択肢の一つとなります。
同じデータを使いますが、ピポットの場合あらかじめソートしておく必要はありません。
ここでは触れませんがピポットには二次元の集計表（商品別日付別実績など）や、類似した２表の差異把握など便利な使用方法が数多くあります。
テーブルの範囲(T)の文字が小さいので拡大すると次のようになります ”Sheet10!$A:$I”
OKを押すと次のような入力画面になります。この時自動的にシートが追加されます。
- 『合成キー』を『行ラベル』にドラッグします
- 『金額』を『Σ値』にドラッグします
- 『Σ値』に表記された文字が『データの個数／金額』であった場合、その場所を左クリックして『値フィールドの設定（N)..』を更に左クリックします
- 左側の選択肢から『合計』を選択します
５．シートの左上に右のような表が現れます。
以上で作業は終了ですが、冒頭で『あらかじめソートしておく必要はありません』と言いましたがこの場合行ラベル順不同で表記されます。昇順にソートする場合は『行ラベル』を左クリックすると『昇順』『降順』の選択ができます。またフィルター機能があって空白行を非表示にできます。
このシートは少し特殊で元のシートとリンクしているため単独で追加・変更ができません。ただし"A3","B3"のタイトル部分は書き換えが可能です。
元のシートと連結しているため『更新』機能を使えば、元の表を追加、変更した時に次の操作で可能です。
集計された表のどこかにカーソルを置くと『ピッポットテーブルツール』が表示されます。そこで『オプション』、『更新』を左クリックすると集計表の内容を書き換えてくれます。
ピポットテーブルには他の便利な機能もありますが、ここでは『小計の値だけを集計する』のが目的なので説明は以上となります。
手数が多いこと、集計結果を使って関数で計算しようとするとうまくいかないケースが多いなどが欠点です。
今度は取引先別日付別データをより時系列別に解りやすい表を作成します。
縦軸に取引先、横軸に日付、集計項目は金額とします。元になる表は同じです。また取引先はコードを用いず、直接名称を使います。時系列で把握しやすくなると思います。
4.マクロを使って集計する(別シートに集計）
『2.小計機能を使用する』と同じような作業をマクロを使って行います。
| Sub TEST10() |
| Dim OLD_KEY As String '前行のキー |
| Dim MaxRow As Long '最大行 |
| Dim i, j As Long ' i =集計対象シートの現在行 |
| 'j = 集計後シートの現在行 |
| Dim SUB_T As Long |
| '集計対象キー Ｉ 列目 |
| '集計対象データ(金額) E列目 |
| '集計対象シート Sheet10 |
| '集計後シート Sheet11 |
| i = 2 |
| j = 2 |
| SUB_T = 0 |
| Sheets("Sheet11").Select |
| '集計シートのタイトル行編集とクリアー |
| Range("A1") = "集計キー" |
| Range("B1") = "金額" |
| Range("A1").CurrentRegion.Offset(1, 0).ClearContents |
| 'Sheet10をキー順にソートする |
| Sheets("Sheet10").Select |
|
Range("A1").CurrentRegion.Sort Key1:=Range("I1"), Order1:=xlAscending, Header:=xlYes '最大行を求める |
| MaxRow = Cells(Rows.Count, 1).End(xlUp).Row |
| OLD_KEY = Cells(2, "i") '1行目でブレイクしないための処理 |
| For i = 2 To MaxRow |
| If OLD_KEY = Cells(i, "I") Then |
| Else |
| '前行とキーが異なった場合の処理 |
| Sheets("Sheet11").Cells(j, 1) = OLD_KEY |
| Sheets("Sheet11").Cells(j, 2) = SUB_T |
| SUB_T = 0 |
| j = j + 1 |
| End If |
| SUB_T = SUB_T + Cells(i, "E") '小計への加算 |
| OLD_KEY = Cells(i, "I") 'キーを OLD_KEYに保管する |
| Next |
| Sheets("Sheet11").Cells(j, 1) = OLD_KEY |
| Sheets("Sheet11").Cells(j, 2) = SUB_T |
| End Sub |
- この考え方は昭和のBasicまたはCOBOLなどで使われた方法で無理に覚える必要はありません。
- 少しでもわかりやすくするためにコメントを増やして色を変えてみました。右はSheet11の計算結果です
- Sheet10のデータを1行ごとに判定して、前行とキーが異なった時（ブレイクした時）だけSheet11へ前行のキーと小計を書き込みにいきます。
- 赤文字は先頭行と最終行の処理です。最初の行は比較する前行がなく、ブレイクしてしまうため最初の行のキーを前行のキー（OLD_KEY)に強制的に代入します。また最終行については"次の行"がこないのでブレイクできないため最後に強制的にブレイクさせます。伝統的なプログラミング技法です。
- 青文字は現在と異なるシートに書き込む時の方法の一つです。クリップボードを使用しないので高速で実行できますが、１項目（１セル）しか代入できません。
- 行数が多い時は Application.ScreenUpdating = False（画面表示の抑止）、Application.Calculation = xlCalculationManual（再計算の抑止）をdim文の後ろに挿入し、End Subの前に元に戻すことを勧めます。
- 戻し方は Application.ScreenUpdating = True（画面表示再開）、Application.Calculation = xlCalculationAutomatic（再計算実行）です。
5.マクロを使って集計する（同一シートに集計）
『2.小計機能を使用する』と同じような作業をマクロを使って行います。
４．マクロを使って集計する(別シートに集計）より難解です。次にSumifsのマクロを作成する予定ですのでこれも読み飛ばしていただいて結構です(2021.11.29追記)
考え方としてはキー順にソートした後に、上から順にキーが前行と同じかどうか１行ずつ判断していくことには変わりありませんが、キーが変わった時に同じシートの（追加した）行に小計を書き込んでいきます。
最後に小計が書き込まれなかった行を全て削除します。
一つのシートで完結すること、キー以外の項目を継承できること（取引先名称など）などがメリットです。
ここではさらなる高速化と、それに伴う『空白行の発生による』
- MaxRow = Cells(Rows.Count, 1).End(xlUp).Row の無効化回避
- Range("An").CurrentRegion.Sort Key1:=Range("Aｍ"), Order1:=xlAscending, Header:=xlYes 無効化回避
について説明します。
上記2つの記述は元データに空白行があると無効になります。（空白行より上しか処理しない）
回避する記述は赤字で示しました。
| Sub TEST11() | |||||
| Dim OLD_KEY As String '前行のキー | |||||
| Dim MaxRow As Long '最大行 | |||||
| Dim i, j As Long ' i =集計対象シートの現在行 | |||||
| Dim SUB_T As Long | |||||
| '集計対象キー Ｉ 列目 | |||||
| '集計対象データ E列目 | |||||
| '集計データ J列目 | |||||
| '集計対象シート Sheet10 | |||||
| i = 2 | |||||
| SUB_T = 0 | |||||
| Application.ScreenUpdating = False '画面更新抑止 | |||||
| Application.Calculation = xlCalculationManual '再計算抑止 | |||||
| Sheets("Sheet10").Select | |||||
| '集計列のタイトル行編集 | |||||
| Range("J1") = "集計値" | |||||
| '最大行の算出 | |||||
|
|||||
| On Error Resume Next | |||||
| MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row | |||||
| If MaxRow < 2 Then MaxRow = 2 | |||||
| Err.Clear | |||||
| End With | |||||
| '合計記述エリアのクリアー | |||||
| Range("J2:J" & MaxRow).ClearContents | |||||
| '合成キーでソートする | |||||
| Range("A1:J" & MaxRow).Sort Key1:=Range("I1"), _ | |||||
| Order1:=xlAscending, Header:=xlYes | |||||
| OLD_KEY = Cells(2, "i") '1行目でブレイクしないための処理 | |||||
| For i = 2 To MaxRow | |||||
| If OLD_KEY = Cells(i, "I") Then | |||||
| Else | |||||
| '前行とキーが異なった場合１行遡って小計を記入する | |||||
| j = i - 1 | |||||
| Cells(j, "J") = SUB_T | |||||
| SUB_T = 0 | |||||
| End If | |||||
| SUB_T = SUB_T + Cells(i, "E") '小計への加算 | |||||
| OLD_KEY = Cells(i, "I") 'キーを OLD_KEYに保管する | |||||
| Next | |||||
| '最後の小計を書き込む | |||||
| j = i - 1 | |||||
| Cells(j, "J") = SUB_T | |||||
| '集計行以外を空白にする | |||||
| For i = 2 To MaxRow | |||||
| If Cells(i, "J") = "" Then | |||||
| Range("A" & i & ":J" & i).ClearContents | |||||
| End If | |||||
| Next | |||||
| '空白行を圧縮するためにソートする | |||||
| Range("A1:J" & MaxRow).Sort Key1:=Range("I1"), _ | |||||
| Order1:=xlAscending, Header:=xlYes | |||||
| Application.ScreenUpdating = True '画面更新再開 | |||||
| Application.Calculation = xlCalculationAutomatic '再計算再開 | |||||
|
End Sub
計算結果 |
1．元の表と変わらないように見えますが、今回の計算で求められたのはＩ列とＪ列だけでＡ～H列は意味がありません。
２．最初の赤文字 途中に空白行があっても最大行を求めることができます。
全くデータがないとエラーになるのでエラートラップしてMaxRowを最低でも２としています（１行目はタイトル行があると見なして）
列によって最大行が異なる場合その最大値がセットされます。
正直仕組みは私もよく分かりませんが、空白行がある可能性がある時は多用しています。
３．２番目の赤文字 範囲指定でのソートです。ソート範囲を対角の２つのセルで指定します。
罫線については ClearContents⇒Clear にすれば消えますが、（データだけソートされて）罫線がソートされずに残るのでまだらになってしまいます。どうしても気になる方は罫線を全て消して、データがある部分だけ罫線を引き直した方が早いです。
どのくらい早くなるかは機会を見つけて実験します。
6.Sumifs関数のマクロを使って集計する
4.5.では１列小計を取り出すにもたいへんな手数がかかりました。10列も20列も小計を得ようとしたならばとんでもないことになります。そこで『報告書の作成』で使ったSumifsをマクロでやってみます。
これも決して簡単とはいえませんが応用範囲は少し広がるかと思います。実は1.から5.までいずれも未完成品でした。取引先別売上年月別の小計は取れても、視覚的には不十分なものでした。縦一列の答えを出すのにこれだけ面倒な作業がひつようなので日付別に横に展開しよとするととんでもないstepになります。
これをSumifs（のマクロ）を使って完成品にしたいと思います。以下の手順を踏みます。
1)別シートを使って小計を落とし込む行を作成する
取引先別のコードと名称を別のシートに丸ごとコピーする。
『重複の削除』を使って１取引先１行の列を作成する（2行目以降)
取引先コードでソートする
2)更に別シートを使って日付を落とし込む行を作成する
日付を別シートに丸ごとコピーする。①
『重複の削除』を使って1日1行の列を作成する②
日付でソートする③
この行を縦横変換の機能を使って1)の2列目以降にコピーする。
（歴月で表を作成するには予めカレンダーを作っておいて①から③は省略する。
以上で小計結果を入れる箱ができました。
次にWorksheetFunction.Sumifs(合計範囲,範囲, 条件,範囲, 条件,・・・) のメソッドを使ってもとの表から数値を集計します。
この時注意したいのはSumifs関数はそこに適正な式を配置しておけば『勝手に』『同時（に見えるくらい早く）』演算してくれましたが、マクロではそうはいきません。
行変数、列変数を使ってすべての（作られた箱の）全てのセルについて１つずつ計算する必要があります。最初の合計範囲は集計すべき数が配置されている場所ですから固定となります。
以下は縦横でピポッド集計するのと同じようなことをSumifsで実行した例です。
VBAで簡単な記述ができる事を目標としてきたのにどんどん深みにはまっていくようです。
あとで詳しく説明しますのでまずは下記のコードと結果をご覧下さい。
'************************************
Sub TEST11B()
'************************************
Dim MaxRow, Max2 As Long
Dim i, j As Long
Dim Range_kin, Range_USR, Range_day As Range
Dim sh1, sh2, sh3 As Worksheet
'*** Sheet2 を初期クリアー
Sheets("Sheet2").Select
Set sh2 = Sheets("Sheet2")
MaxRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:Z" & MaxRow).Clear
'*** Sheet3 を初期クリアー
Sheets("Sheet3").Select
Set sh3 = Sheets("Sheet3")
MaxRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:Z" & MaxRow).Clear
Sheets("Sheet1").Select
Set sh1 = Sheets("Sheet1")
MaxRow = Cells(Rows.Count, "A").End(xlUp).Row
Set Range_kin = sh1.Range("E2:E" & MaxRow) ’金額
Set Range_USR = sh1.Range("H2:H" & MaxRow) '取引先
Set Range_day = sh1.Range("F2:F" & MaxRow) '日付
'*** 取引先をSheet2 にコピー
Range("Ｈ1:H" & MaxRow).Copy
sh2.Range("A1").PasteSpecial xlPasteValues
'重複削除とソート
sh2.Select
Range("A:A").RemoveDuplicates Columns:=Array(1), Header:=xlYes '重複削除
Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlYes
MaxRow = Cells(Rows.Count, "A").End(xlUp).Row
sh1.Select
'*** 日付をSheet3 にコピー
Max2 = Cells(Rows.Count, "A").End(xlUp).Row
Range("F1:F" & Max2).Copy
sh3.Range("A1").PasteSpecial Paste:=xlAll
sh3.Select
Range("A:A").RemoveDuplicates Columns:=Array(1), Header:=xlYes '重複削除
Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlYes
Max2 = Cells(Rows.Count, "A").End(xlUp).Row
Range("A2:A" & Max2).Copy
sh2.Range("B1").PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
sh2.Select
For i = 2 To MaxRow '縦軸 =4
For j = 2 To Max2 '横軸 = 8
Cells(i, j) = WorksheetFunction.SumIfs(Range_kin, Range_USR, Cells(i, 1), Range_day, Cells(1, j))
Next j
Next i
End Sub
わかりにくい文法について解説していきます。
Dim Range_kin, Range_USR, Range_day As Range
Dim sh1, sh2, sh3 As Worksheet
両方とも As String の表記も可能ですが、As Range とか As WorkSheetとすることで、コードを大幅に短縮することができます。
たとえば Dim Range_kin As String と Dim Range_kin As Range の違いは
もしあるBookdをActivateして、そのうえであるSheetをSelectしたうえで次の命令を実行した場合の違いです。
Range_kin = Range("A2:E5") --- As String で定義した場合 ①
Set Range_kin = Range("A2:E5") --- As Range で定義した場合 ②（As Rangeで定義したオブジェクトに代入する時はSetを使用しなければいけません）
そのあと異なるBook,Sheetを選択した後
Range_kin = 0 を実行すると
①現在 Activateしている Bookの Selectしたシートの Range("A2:E5")を 0 とします。
②最初に定義した時の Sheet,Bookの Range("A2:E5")を 0 とします。
正直クリアーする時はあまり使いませんが、Vlookup,Match,sumifsをマクロで実行するときは文の短縮化と視認性向上に大きく役立ちます。
同じようにAs Worksheet で定義すると、どのWorkBookを Activateしていても、最初Setした時のBookのなかのSheetを指すことになります。
Range("A2:A" & Max2).Copy
sh2.Range("B1").PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
今回の集計は日付を横軸にするので元の表では縦に並んでいた日付を縦横逆に張り付けます。
For i = 2 To MaxRow '縦軸 =4
For j = 2 To Max2 '横軸 = 8
Cells(i, j) = WorksheetFunction.SumIfs(Range_kin, Range_USR, Cells(i, 1), Range_day, Cells(1, j))
Next j
Next i
この二重のループは慣れないとなかなか厄介です。慣れても永久ループに陥ることがしばしばあります。
Nextの後ろの i や j は必ずしも必要ではありません。
この二重ループは対象のすべてのセルに対して sumifs命令を実行するための仕組みです。
縦軸に関しては最初２から始まります。iが２の値をとっているとき j は２から８までループします。
次に i が 3 の値をとっているとき j は２から８までループします。
実際の Cells(i,j)の価は
(2,2)(2,3)(2,4)(2,5)(2,6)(2,7)(2,8)
(3,2)(3,3)(3,4)(3,5)(3,6)(3,7)(3,8)
(4,2)(4,3)(4,4)(4,5)(4,6)(4,7)(4,8) という組み合わせで推移していきます。
Cells(i, j) = WorksheetFunction.SumIfs(Range_kin, Range_USR, Cells(i, 1), Range_day, Cells(1, j))
WorksheetFunction.SumIfs(Range_kin, ⇒ 集計前の表の金額の列(E列)を（次の条件で）集計します
Range_USR, Cells(i, 1), ⇒ 取引先名(集計前のH列)が実行時の行の1列めと等しく かつ
Range_day, Cells(1, j) ⇒ 日付(集計前のF列)が実行時の列の1行めと等しい
この前のセクションの『報告書の作成』では関数のSumifs が使われていますので比較してみてください。
使いやすい方を使った方がよいと思います。速度は計っていませんが、おそらく関数の方が早いです。
それでもVBAで実行が有利な場合は、さらに複雑な条件で抽出する場合や、集計結果を更に加工する場合などです。