VBA 部門合計と支社合計の行を追加したい

VBAでExcelの給与データに部門合計と支社合計の行を追加したいです。
追加する合計行は、合計された数値を入れるのではなく「=SUM」の形で表示。

|職員№|職員名|支社№|支社名|部門№|部門名|1月|2月|3月|4月|5月|6月|7月|8月|9月|10月|11月|12月|合計|
|:--|:--:|--:|
|1|A|1|ねこ|1|役員|4500|4500|4500|4500|4500|4500|4500|4500|4500|4500|4500|4500|54000|
|2|B|1|ねこ|1|役員|3500|3500|3500|3500|3500|3500|3500|3500|3500|3500|3500|3500|42000|
|3|C|2|いぬ|2|営業|255|258|243|255|258|254|245|245|245|245|245|245|2993|
|4|D|2|いぬ|2|営業|230|243|230|230|267|245|245|247|245|245|245|245|2917|
|5|E|2|いぬ|3|事務|163|197|160|164|210|201|173|188|191|173|173|173|2166|
|6|F|2|いぬ|4|企画|163|198|204|198|204|212|212|155|142|137|145|145|2115|
|7|G|2|いぬ|4|企画|717|111|102|142|389|464|107|977|418|687|726|977|5817|
|8|H|2|いぬ|5|SE|514|429|623|670|701|596|998|889|101|317|432|889|7159|
|9|I|3|うさぎ|3|事務|235|251|235|235|266|245|245|223|249|245|245|266|2940|
|10|G|3|うさぎ|4|企画|163|197|160|164|210|201|173|188|191|173|173|210|2203|

※元データイメージ図

※完成イメージ図

部門合計の行の追加、合計行（イメージ図の灰色の部分）と支社合計行の追加（薄緑）までは出来たのですが、
支社合計のSUM関数部分の出し方が分からなくて詰まってしまいました。
G28（いぬ支社合計）は「=SUM(G27,G25,G22,G20)」、G33（うさぎ支社合計）は「=SUM(G32,G30)」としたいです。

Sub test()
 
    Dim intSortCol As Integer
    Dim intSortRow As Integer
    
    Dim r As Integer
    Dim k As Integer
    Dim i As Integer
    Dim j As Integer
    Dim c As Integer
    Dim v As Integer
    r = 6
    i = 0
    j = 0
    v = 3

    
    
    intSortCol = Sheets("Sheet1").Cells(4, Columns.Count).End(xlToLeft).Column
    intSortRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    For k = 1 To intSortRow
        If Cells(r, 5) <> Cells(r - 1, 5) Then
               
            Rows(r).Insert
            Range(Cells(r, 1), Cells(r, intSortCol)).Interior.color = RGB(192, 192, 192)
                                                
            If Cells(r - 1, 5) = 1 Then
                Cells(r, 1) = "役員計"
                Cells(r, 3) = Cells(r - 1, 3)
                Cells(r, 3).Font.color = RGB(192, 192, 190)
            End If
                                    
            If Cells(r - 1, 5) = 2 Then
                Cells(r, 1) = "営業計"
                Cells(r, 3) = Cells(r - 1, 3)
                Cells(r, 3).Font.color = RGB(192, 192, 190)
            End If
            
            If Cells(r - 1, 5) = 3 Then
                Cells(r, 1) = "事務計"
                Cells(r, 3) = Cells(r - 1, 3)
                Cells(r, 3).Font.color = RGB(192, 192, 190)
            End If
            
            If Cells(r - 1, 5) = 4 Then
                Cells(r, 1) = "企画計"
                Cells(r, 3) = Cells(r - 1, 3)
                Cells(r, 3).Font.color = RGB(192, 192, 190)
            End If
            
                For c = 9 To intSortCol
                
                        Cells(r, c) = "=SUM(" & Cells(v, c).Address(False, False) & ":" & Cells(r - 1, c).Address(False, False) & ")"
                    j = j + 1
                    
                Next c
                
                r = r + 1
                v = r
                i = i + 1
 
        End If
        r = r + 1
    Next k
    
 End Sub

よろしくお願い致します。

行動規範の内容に同意します

回答1件

ベストアンサー

まず、Rows(r).Insert で行を挿入すると、後の表部分が後ろにずれます。最終行もずれます。
For Next で前から挿入していくと、だんだんずれていくので行位置が合わなくなります。

対処法としては、下記の２つがあります。

(1) For Next で後ろから前へ移動しながら挿入していく。
これなら、前部分はずれないので問題なく移動できます。

(2) Do Loop で前から後ろに移動しながら挿入していき、空白セルになるまで繰り返します。

次に、合計の式の設定ですが、
Cと集計の開始行が分からないので、いったん後ろから行挿入だけしてから、また、先頭から移動しながら、開始行を変数に格納しておいて、空白行で合計の式を代入するようにします。
あるいは、空白行で区切られているので、CurrentRegionを使うと集計範囲を一発でしゅとくできますので、それを利用してもいいでしょう。

(2)の方法なら、後ろに移動しながら、先頭行を変数に格納しておいて、キー値が変わったら行を挿入して、同時に合計の式も設定できます。

最後に合計の式ですが、SUM関数だと、中計や総計は、=SUM(G27,G25,G22,G20)というようにとびとびのセルを指定する必要があり面倒です。

SUBTOTAL関数を使うと連続したセル範囲を指定しても、集計行はとばして集計してくれますので楽できます。
SUBTOTAL関数でさまざまな集計値を求める | Excel関数 | できるネット

とりあえずヒントだけ出しておきますので、上記を参考にチャレンジしてみてください。

サンプルコードを作成しましたので、ご参考に。

vba
1Sub test()
2    Dim s支社 As Long '支社開始行
3    Dim s部門 As Long '部門開始行
4    Dim r As Long
5    s支社 = 2
6    s部門 = 2
7    r = 2
8    
9    Do Until Cells(r - 1, 1) = ""
10        If Cells(r, 5) <> Cells(s部門, 5) Then
11            Rows(r).Insert
12            
13            Cells(r, 1).Value = Cells(s部門, 6) & "計"
14            Cells(r, 1).Resize(1, 19).Interior.Color = RGB(192, 192, 192)
15            Range(Cells(r, 7), Cells(r, 19)).Formula = "=SUBTOTAL(9,G" & s部門 & ":G" & r - 1 & ")"
16            r = r + 1
17            s部門 = r
18        End If
19        If Cells(r, 3) <> Cells(s支社, 3) Then
20            Rows(r).Insert
21            Cells(r, 1).Value = Cells(s支社, 4) & "計"
22            Cells(r, 1).Resize(1, 19).Interior.Color = RGB(226, 239, 219)
23            Range(Cells(r, 7), Cells(r, 19)).Formula = "=SUBTOTAL(9,G" & s支社 & ":G" & r - 1 & ")"
24            r = r + 1
25            s部門 = r
26            s支社 = r
27        End If
28        r = r + 1
29    Loop
30    
31    r = r - 1
32    Cells(r, 1).Value = "総計"
33    Cells(r, 1).Resize(1, 19).Interior.Color = RGB(192, 226, 239)
34    Range(Cells(r, 7), Cells(r, 19)).Formula = "=SUBTOTAL(9,G2:G" & r - 1 & ")"
35End Sub