指定した件数ごとに小計行を挿入するのは意外に難しかった。

先日の覚書(マクロ)の続きです。
先日はTABでデコボコになったデータをRIGHT等で等幅にするというのをメモしたんですが、後輩の要望には続きがあって一定の件数ごとに小計を出したいというものです。
A列からF列で、金額はF列、ヘッダーも含めて40行(処理ごとに行数は変わります)↓Sampleデータマクロ実行前
MAE.jpg
下は10件ごとにSUM関数で小計だすコード、かなり試行錯誤しました(;^_^A
ネットで検索すると「項目ごとに小計」、エクセルの「小計」機能を利用したものなどはあるんですが単純に10行ごとの小計をだす
コードが引っ掛からない、3行ごとに小計を求めるとかあったんですけどコードが長くて使う気がしない。
そんな感じでした。したのコードもjに+11したら上手くいったんですけど、これやんないと最後の10件未満の集計がうまくいかず手探り状態でなんとかしました。

Sub TEST()
Dim i As Integer
Dim j As Integer
j = Cells(1, 1).End(xlDown).Row ’上の例ではj=40
For i = 12 To j + 11 Step 11   ’最初が12なのはヘッダー行があるから11は10+集計行
Rows(i).Insert
j = j + 1             ’行を挿入したのでj+1
Cells(i, "E").Value = "小計"
Cells(i, "E").Interior.ColorIndex = 44 ’省略可
Cells(i, "F").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
Next
End Sub


↓マクロ実行後
ATO.jpg
いい感じだと思ったのですが行数を変えてテストしたら、最終グループの集計がうまくいかない場合も( ^ω^)・・・
追記欄にその場しのぎの不細工なコードで対応したので。お時間のあるかたはのぞいてみてください。

Sub TEST2()

Dim i As Integer
Dim j As Integer
Dim cnt As Integer
j = Cells(1, 1).End(xlDown).Row
cnt = 1
For i = 12 To j + 11 Step 11
Rows(i).Insert
j = j + 1
Cells(i, "E").Value = "小計" & "(" & cnt & ")"
Cells(i, "E").Interior.ColorIndex = 44
Cells(i, "F").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
cnt = cnt + 1
Next
'10件未満のレコードが残ったとき
Cells(i, "E").Value = "小計" & "(" & cnt & ")"
Cells(i, "E").Interior.ColorIndex = 44
Cells(i, "F").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
'集計行が不要な場合
If Cells(i, "F").Value = 0 Then
Rows(i).Delete
End If
End Sub

少しいじってみました。備忘録として保存。
ATO2.jpg
関連記事
スポンサーサイト



コメントの投稿

非公開コメント

訪問者さま
カレンダー
09 | 2020/10 | 11
- - - - 1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30 31
プロフィール

arakurikaesiki

Author:arakurikaesiki
阿良々木(あらくりかえしき)と申します。趣味はらくがき/アクアリウム、好きな小説は物語シリーズです。あと、仕事で楽したいためにExcelのVBAをちょくちょくいじってます。
なお、当ブログはリンクフリーです、よろしければリンク貼ってください。
また、ブロともさまも募集中です。コメントとかもらえるとすごく喜びます。

ブロとも様募集中ですm(_)m

この人とブロともになる

最新コメント
リンク(敬称略)
らくがき
新着記事
参照不可? Oct 20, 2020
基幹システムの入れ替えと使えなくなるファイルメーカー Sep 30, 2020
季節の変わり目 Sep 01, 2020
ロード長くね? Aug 19, 2020
ルフィを描いてみた Aug 17, 2020
囲んで塗る? Aug 14, 2020
100.00cm Aug 12, 2020
サメ Aug 08, 2020
チョット多すぎる Aug 08, 2020
・・・・・・ Aug 06, 2020
カテゴリ
アクセスランキング
[ジャンルランキング]
ブログ
3191位
アクセスランキングを見る>>

[サブジャンルランキング]
イラストブログ
115位
アクセスランキングを見る>>
にほんブログ村(ビオトープ)
月別アーカイブ
人気ブログランキング
更新通知登録ボタン

更新通知で新しい記事をいち早くお届けします

検索フォーム