Sub 小計集計書込みグループ化()
 
Dim 入力File As String
Dim 入力Tab As String
Dim myRange As AutoFilter
Dim RowMin As Long
Dim RowMax As Long
Dim J As Long
Const MaxBar As Integer = 26
Dim Step As Long
Dim Next_Step As Long
Dim ws As Worksheet
Dim flag As Boolean
Dim 合計コード As Integer
Dim 小計コード As Integer
Dim 小計A As Double
Dim 小計B As Double
Dim 合計A As Double
Dim 合計B As Double
Dim 値A列 As Integer
Dim 値B列 As Integer
Dim 小計キー列 As Integer
Dim 合計キー列 As Integer
Dim 小計キー列文字 As String
Dim 合計キー列文字 As String
Dim 列Max As String
Dim GroupStart As Long
Dim TopGroupStart As Long
Dim GroupEnd As Long
Dim TopGroupEnd As Long
Dim 合計キーセル As Variant
Dim 小計キーセル As Variant
 
入力ファイル = "小計合計サンプル.xlsx"
入力Tab = "月別売上原価"

値A列 = 3               '集計する値A列番号
値B列 = 4               '集計する値B列番号
小計キー列 = 2          '小計キー列番号
合計キー列 = 1          '合計キー列番号
小計キー列文字 = "B"    '小計キー列名
合計キー列文字 = "A"    '合計キー列名
RowMin = 2
列Max = "I"
 
'Application.ScreenUpdating = False
 
'入力ファイル、入力タブ(シート）の指定
    Windows(入力ファイル).Activate
    Sheets(入力Tab).Select
'入力データの最大行検出
    RowMax = Cells(Rows.Count, 1).End(xlUp).Row

'合計_小計列名をキーに昇順ソート
    ActiveWorkbook.Worksheets(入力Tab).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(入力Tab).Sort.SortFields.Add Key:=Range( _
        合計キー列文字 & RowMin & ":" & 合計キー列文字 & RowMax), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(入力Tab).Sort.SortFields.Add Key:=Range( _
        小計キー列文字 & RowMin & ":" & 小計キー列文字 & RowMax), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(入力Tab).Sort
        .SetRange Range("A1:" & 列Max & RowMax)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'データを順に読みながら小計キー、合計キーごとの集計を書込む
        小計A = 0
        小計B = 0
        合計A = 0
        合計B = 0
        GroupStart = RowMin
        TopGroupStart = RowMin
 
    J = 1
'A列値、B列値を読んで、小計、合計に加算
    Do While J <= RowMax
        J = J + 1
        小計キーセル = Cells(J, 小計キー列).Value
        合計キーセル = Cells(J, 合計キー列).Value
        小計A = 小計A + Cells(J, 値A列).Value
        小計B = 小計B + Cells(J, 値B列).Value
        合計A = 合計A + Cells(J, 値A列).Value
        合計B = 合計B + Cells(J, 値B列).Value
        
        If 小計キーセル <> Cells(J + 1, 小計キー列).Value Or J = RowMax Then
'次のレコードで小計種類が変わる             小計種類グループを終了し、1行追加して小計を書込む
            GroupEnd = J
            Rows(J + 1).Select
            Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(J + 1, 小計キー列).Value = 小計キーセル & "　小計"
            Cells(J + 1, 値A列).Value = 小計A
            Cells(J + 1, 値B列).Value = 小計B
        
'ここまでをグループ化
            Rows(GroupStart & ":" & GroupEnd).Select
            Selection.Rows.Group
            ActiveSheet.Outline.ShowLevels RowLevels:=1

            小計A = 0
            小計B = 0
            RowMax = RowMax + 1
            J = J + 1
            GroupStart = J + 1
        End If
        If 合計キーセル <> Cells(J + 1, 合計キー列).Value Or J = RowMax Then
'次のレコードで合計種類が変わる              合計種類グループを終了し、1行追加して小計を書込む
            If 小計A <> 0 Then
'直前に小計種類の区切りが来ていない（次の集計種類の小計種類と現レコードの小計種類が同じ）
'まず小計種類の区切りを付ける
                GroupEnd = J

                Rows(J + 1).Select
                Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove

                Cells(J + 1, 小計キー列).Value = 小計キーセル & "　小計"
                Cells(J + 1, 値A列).Value = 小計A
                Cells(J + 1, 値B列).Value = 小計B

'ここまでをグループ化(レベル２）
                Rows(GroupStart & ":" & GroupEnd).Select
                Selection.Rows.Group
                ActiveSheet.Outline.ShowLevels RowLevels:=1

                小計A = 0
                小計B = 0
                RowMax = RowMax + 1
                J = J + 1
            End If
'合計種類の区切りをつける                     1行追加して合計を書込む
            TopGroupEnd = J
            Rows(J + 1).Select
            Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(J + 1, 合計キー列).Value = 合計キーセル
            Cells(J + 1, 小計キー列).Value = "合計"
            Cells(J + 1, 値A列).Value = 合計A
            Cells(J + 1, 値B列).Value = 合計B
            
'ここまでをグループ化(レベル１）
            Rows(TopGroupStart & ":" & TopGroupEnd).Select
            Selection.Rows.Group
            ActiveSheet.Outline.ShowLevels RowLevels:=1

            合計A = 0
            合計B = 0
            RowMax = RowMax + 1
            J = J + 1
            GroupStart = J + 1
            TopGroupStart = GroupStart
        End If
        
    Loop
    
MsgBox "小計、合計処理を終了しました。"

Application.ScreenUpdating = True

Exit Sub

Errorhandler:

End Sub