エクセルマクロで表の途中の集計行と合計行追加

質問

こんなことできますか？
エクセルの表が各シートに一つずつあります。

B列からR列まで使用しています。
始まりは３行目で見出し行です。
データは４行目以降ですが、これは各シートごとに最終行は異なります。だいたい１２０行から２００行程度です。
途中に空白はありません。
この表はS列の数値（１２種類）により分類され並べ替えてあります。

やりたいのは、S列の数値を見て、分類（同じ数字）ごとに集計する行を追加したいのです。
集計する列は、D～K列だけです。
そして、最終行に全部の合計も出したいのです。

ただ、量が多いのと、頻繁に行なう作業なのでマクロでささっと出来ないかと思います。
どなたかどうすればよいか教えてください。
なにとぞお願いします。

回答No.1

BLUEPIXY · ベストアンサー

マクロを使わなくても、
メニューの「データ」～「集計」でできると思います。

お礼

こんな便利な機能があったんですね。
眼からウロコです。

ありがとうございました。

回答No.3

imogasi

VBAで
Sub test01()
Dim s(30) '小計をいれる配列
Dim st(30) '総計をいれる配列
'---データスタート行のキーコード
m = Cells(4, "S")
'----Ｄ列－Ｋ列の小計・総計エリアクリア
For c = 4 To 11
s(c) = 0
st(c) = 0
Next c
'=================１行づつ繰り返し
i = 4
While (Cells(i, "S") <> "")
If Cells(i, "S") = m Then
'--前行とＳ列で変わらない場合は足しこみ
For c = 4 To 11
s(c) = s(c) + Cells(i, c)
Next c
'----変わった
Else
Cells(i, "S").EntireRow.Insert '行挿入
'----小計を挿入行のＤ列－Ｋ列にセット
'---Ｄ列－Ｋ列の小計をＤ列－Ｋ列の総合計に足しこみ
For c = 4 To 11
Cells(i, c) = s(c)
st(c) = st(c) + s(c)
s(c) = 0
Next c
'----行挿入したので行ポインタｉと最下行ｄを１行下へづらす
i = i + 1
'----変わった最初行Ｄ列－Ｋ列を足しこみ
For c = 4 To 11
s(c) = s(c) + Cells(i, c)
Next c
'----現在のキーコードを変更
m = Cells(i, "S")
End If
i = i + 1
Wend
'=================最終行後
'----小計を最終行の次行のＤ列－Ｋ列にセット
'---Ｄ列－Ｋ列の小計をＤ列－Ｋ列の総合計に足しこみ
For c = 4 To 11
Cells(i, c) = s(c)
st(c) = st(c) + s(c)
s(c) = 0
Next c
'----総合計をＤ列－Ｋ列にセット
i = i + 1
For c = 4 To 11
Cells(i, c) = st(c)
Next c
End Sub
Ｓ列のキーコードが変るたびに行挿入し、そこのＤ－Ｋ列小計をセットしている。
４０行程度でテスト済み。

お礼

ありがとうございました。

回答No.2

jindon

VBAですと、

Sub total()
Dim ws As Worksheet, i As Long, ii As Long, lastS As Long
For Each ws In Sheets
With ws
i = 4
Do Until IsEmpty(.Cells(i, 19))
lastS = .Range("s65536").End(xlUp).Row
If lastS < i + 1 Then
lastS = i + 1
End If
For ii = i + 1 To lastS
If IsEmpty(.Cells(ii, 19)) Then
.Cells(ii, 3).Value = "小計"
.Cells(ii, 4).FormulaR1C1 = _
"=subtotal(9,r" & i & "c:r[-1]c)"
.Cells(ii, 4).AutoFill _
Destination:=ws.Range("d" & ii & ":k" & ii)
ElseIf .Cells(i, 19) <> .Cells(ii, 19) Then
.Rows(ii).Insert
.Cells(ii, 3).Value = "小計"
.Cells(ii, 4).FormulaR1C1 = _
"=subtotal(9,r" & i & "c:r[-1]c)"
.Cells(ii, 4).AutoFill _
Destination:=ws.Range("d" & ii & ":k" & ii)
lastS = .Range("s65536").End(xlUp).Row
i = ii + 1
Exit For
Else
End If
Next
i = ii + 1
Loop
.Cells(lastS + 1, 3).Value = "合計"
With .Cells(lastS + 1, 4)
.FormulaR1C1 = "=subtotal(9,r5c:r[-1]c)"
.AutoFill Destination:=ws.Range("d" & lastS + 1 & ":k" & lastS + 1)
End With
End With
Next
End Sub

お礼

ありがとうございました。