このようなサンプルですが、A列のグループごとに小計と全体の合計をグループの下に入れます。
(画像をクリックすると、このサンプルがダウンロードできます)
今回は「簡単な方法」と「面倒くさい方法」の両方をご案内します。
「簡単な方法」はExcelの「データ」メニューにある「集計」です。自動記録で「集計」を行なってコードを整理すると、こんな感じになります。
'***************************************************************************************************
' 小計の挿入サンプル Module1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/05/27(1.00)新規作成
'05/05/01(1.01)初回修正
'20/02/22(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
Option Private Module
'***************************************************************************************************
' ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :InsertSubtotal1
'* 機能 :小計の挿入①
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年01月01日
'* 作成者 :井上 治
'* 更新日 :2020年02月22日
'* 更新者 :井上 治
'* 機能説明:Excelの小計機能
'* 注意事項:
'***************************************************************************************************
Sub InsertSubtotal1()
Attribute InsertSubtotal1.VB_Description = "マクロ記録日 : 2003/7/16 ユーザー名 : 井上治"
Attribute InsertSubtotal1.VB_ProcData.VB_Invoke_Func = " \n14"
'-----------------------------------------------------------------------------------------------
' Excelの小計機能
Range("$A$1:$C$13").Subtotal GroupBy:=1, _
Function:=xlSum, _
TotalList:=Array(3), _
Replace:=True, _
PageBreaks:=False, _
SummaryBelowData:=True
' 本ブックを保存済みにする
ThisWorkbook.Saved = True
End Sub
'***************************************************************************************************
'* 処理名 :InsertSubtotal2
'* 機能 :小計の挿入②
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年01月01日
'* 作成者 :井上 治
'* 更新日 :2020年02月22日
'* 更新者 :井上 治
'* 機能説明:コード上で独自処理
'* 注意事項:
'***************************************************************************************************
Sub InsertSubtotal2()
'-----------------------------------------------------------------------------------------------
Dim lngRow As Long ' 行INDEX
Dim lngRow1 As Long ' 行INDEX(グループの先頭)
Dim lngRow2 As Long ' 行INDEX(グループの最終)
' 2行目から処理開始(見出し1行)
lngRow = 2
' A列がブランクになるまで繰り返す
Do While Cells(lngRow, 1).Value <> ""
' 小計グループの先頭行→lngRow1
lngRow1 = lngRow
lngRow = lngRow + 1
' 次の行から同じグループでない行を見つける
Do While Cells(lngRow, 1).Value = Cells(lngRow1, 1).Value
lngRow = lngRow + 1
Loop
' 同じグループの最終行→lngRow2
lngRow2 = lngRow - 1
' 小計行を挿入
Rows(lngRow).Insert
Cells(lngRow, 1).Value = Cells(lngRow1, 1).Value & "の小計"
Cells(lngRow, 3).FormulaR1C1 = "=SUBTOTAL(9,R" & lngRow1 & "C:R" & lngRow2 & "C)"
' 小計行挿入した分を加算
lngRow = lngRow + 1
Loop
' 総合計
Cells(lngRow, 1).Value = "合計"
Cells(lngRow, 3).FormulaR1C1 = "=SUBTOTAL(9,R1C:R" & lngRow2 & "C)"
' 本ブックを保存済みにする
ThisWorkbook.Saved = True
End Sub
'----------------------------------------<< End of Source >>----------------------------------------