グループ制御

前項の「小計の挿入」の独自操作でグループ化を追加すると、こんな感じになります。

前項の「小計の挿入」で、「集計」機能によりグループ化も同時に行なわれることを説明しましたが、これを独自にやるとしたら、こんな感じです。


'***************************************************************************************************
'   グループ制御のサンプル                                          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

'***************************************************************************************************
'   ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :InsertGroups
'* 機能  :グループ制御のサンプル
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年05月27日
'* 作成者 :井上 治
'* 更新日 :2020年02月22日
'* 更新者 :井上 治
'* 機能説明:小計の挿入+グループ制御
'* 注意事項:
'***************************************************************************************************
Sub InsertGroups()
    '-----------------------------------------------------------------------------------------------
    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)"
        ' グループの挿入
        Rows(lngRow1 & ":" & lngRow2).Group
        ' 小計行挿入した分を加算
        lngRow = lngRow + 1
    Loop
    ' 総合計
    Cells(lngRow, 1).Value = "合計"
    Cells(lngRow, 3).FormulaR1C1 = "=SUBTOTAL(9,R2C:R" & lngRow2 & "C)"
    ' グループの挿入
    Rows("2:" & lngRow - 1).Group
    ' 本ブックを保存済みにする
    ThisWorkbook.Saved = True
End Sub

'----------------------------------------<< End of Source >>----------------------------------------

これは、前項の「小計の挿入」の「面倒な方法」に赤枠の部分を加えただけです。
グループ化
(画像をクリックすると、このサンプルがダウンロードできます)
動作させると、このようになります。