回答編集履歴

1

コード追記

2021/12/14 14:39

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -45,3 +45,91 @@
45
45
 
46
46
 
47
47
  とりあえずヒントだけ出しておきますので、上記を参考にチャレンジしてみてください。
48
+
49
+
50
+
51
+ ---
52
+
53
+ サンプルコードを作成しましたので、ご参考に。
54
+
55
+
56
+
57
+ ```vba
58
+
59
+ Sub test()
60
+
61
+ Dim s支社 As Long '支社開始行
62
+
63
+ Dim s部門 As Long '部門開始行
64
+
65
+ Dim r As Long
66
+
67
+ s支社 = 2
68
+
69
+ s部門 = 2
70
+
71
+ r = 2
72
+
73
+
74
+
75
+ Do Until Cells(r - 1, 1) = ""
76
+
77
+ If Cells(r, 5) <> Cells(s部門, 5) Then
78
+
79
+ Rows(r).Insert
80
+
81
+
82
+
83
+ Cells(r, 1).Value = Cells(s部門, 6) & "計"
84
+
85
+ Cells(r, 1).Resize(1, 19).Interior.Color = RGB(192, 192, 192)
86
+
87
+ Range(Cells(r, 7), Cells(r, 19)).Formula = "=SUBTOTAL(9,G" & s部門 & ":G" & r - 1 & ")"
88
+
89
+ r = r + 1
90
+
91
+ s部門 = r
92
+
93
+ End If
94
+
95
+ If Cells(r, 3) <> Cells(s支社, 3) Then
96
+
97
+ Rows(r).Insert
98
+
99
+ Cells(r, 1).Value = Cells(s支社, 4) & "計"
100
+
101
+ Cells(r, 1).Resize(1, 19).Interior.Color = RGB(226, 239, 219)
102
+
103
+ Range(Cells(r, 7), Cells(r, 19)).Formula = "=SUBTOTAL(9,G" & s支社 & ":G" & r - 1 & ")"
104
+
105
+ r = r + 1
106
+
107
+ s部門 = r
108
+
109
+ s支社 = r
110
+
111
+ End If
112
+
113
+ r = r + 1
114
+
115
+ Loop
116
+
117
+
118
+
119
+ r = r - 1
120
+
121
+ Cells(r, 1).Value = "総計"
122
+
123
+ Cells(r, 1).Resize(1, 19).Interior.Color = RGB(192, 226, 239)
124
+
125
+ Range(Cells(r, 7), Cells(r, 19)).Formula = "=SUBTOTAL(9,G2:G" & r - 1 & ")"
126
+
127
+ End Sub
128
+
129
+ ```
130
+
131
+
132
+
133
+ 実行結果
134
+
135
+ ![イメージ説明](a06d99ae1b1bfeda87923537fd8bfb4f.png)