エクセルで行を挿入して小計合計を出したい
- 支店コードと金額、手数料が入力されているエクセルデータにおいて、支店コードごとに小計と合計を計算するマクロについての質問です。
- 参考にしたマクロでは、支店コードが同じ場合は行を挿入して小計を計算していますが、支店コードが1件しかない場合は行を挿入せずにそのままの状態にしたい場合、どのように修正すれば良いか教えていただきたいです。
- また、複数の支店コードがある場合には、行を挿入して小計を計算し、最後に合計を計算するようになっています。
- ベストアンサー
エクセルで行を挿入して小計合計を出したい
質問ですが,以下の参考としたマクロについて,データが1支店1件しかない場合は行を挿入せずにこのままとしたい場合はどのように修正すれば良いか教えていただけませんでしょうか。 1支店2件以上のデータがある場合は,以下の参考としたマクロのとおり行を挿入して小計を計算表示する。 支店コード1001 20000円 200円 ← 行挿入不要 小計無し 1002 30000円 200円 1002 45000円 300円 小計 75000円 500円 参考にした質問・アドレス A列に支店コード(4桁の数値)、J列に金額、K列に手数料があります。 支店は5箇所でデータは1支店あたり100~500行ほどあります。全支店のデータが連続しています。 1.支店コードの最終行の下に1行挿入し、J列,K列の小計を計算する。 2.最後の支店の小計の下に一行あけてJ列,K列の合計をしたい。 Sub test01() d = Range("a2").CurrentRegion.Rows.Count ' MsgBox d Cells(d + 1, 1) = "END" Dim st1, gt1, st2, gt2 As Long st1 = 0: gt1 = 0: st2 = 0: gt2 = 0 mk = Cells(2, 1) '========== For i = 2 To 10000 If Cells(i, 1) = "END" Then Exit For '最終行判定 If Cells(i, 1) = mk Then '前行とコード同じか '------今回行分加算 st1 = st1 + Cells(i, 2) st2 = st2 + Cells(i, 3) Else mk = Cells(i, 1) '--------小計 Cells(i, 1).EntireRow.Insert Cells(i, 1) = "小計" Cells(i, 2) = st1 gt1 = gt1 + st1 st1 = 0 Cells(i, 3) = st2 gt2 = gt2 + st2 st2 = 0 '-----今回行分加算 i = i + 1 st1 = st1 + Cells(i, 2) st2 = st2 + Cells(i, 3) End If Next i '============終了 '-------小計 Cells(i, 1) = "小計" MsgBox st1 Cells(i, 2) = st1: gt1 = gt1 + st1: st1 = 0 Cells(i, 3) = st2: gt2 = gt2 + st2: st2 = 0 '-------合計 Cells(i + 1, 1) = "合計" Cells(i + 1, 2) = gt1 Cells(i + 1, 3) = gt2 End Sub アドレス http://okwave.jp/qa/q414647.html
- mino33mino
- お礼率84% (11/13)
- Excel(エクセル)
- 回答数2
- ありがとう数17
- みんなの回答 (2)
- 専門家の回答
質問者が選んだベストアンサー
こんにちは。 そのコードは、imogasiさんのだったのですね。内容は分かりにくいけれども、実行できますね。 ここでは、おなじみでしたが、書かなくなったお一人です。彼独特のコードは、思い出深いものがあります。ピボットという方法が、常識的ではあるけれども、一応、元のコードと同じ手法で書きます。合計値は、計算式にしました。 レイアウトは、以下のように、1行目は、「支店コード 金額 手数料」と想定したマクロです。 1 支店コード…… 2 1001 20000円 200円 3 1002 30000円 200円 4 1002 45000円 300円 5 小計 75000円 500円 タイトル行がなくて、A1から始まるのなら、CL ="A", i =1 というように書き換えてください。 '// Sub Test01() Dim rng As Range Dim i As Long Dim cnt As Long Dim cnt2 As Long Const CL As String = "I" '最初の列 i = 2 '開始行 Set rng = Cells(i, CL).CurrentRegion.Columns(1) '二重計算のミスを防ぐ If Application.CountBlank(rng) > 0 Then MsgBox "空白行があって、正しく実行されません。", vbExclamation Exit Sub ElseIf Application.CountIf(rng, "小 計") > 0 Then MsgBox "すでに計算されたものだと思われます。", vbExclamation Exit Sub End If Application.ScreenUpdating = False Do If IsNumeric(Cells(i, CL).Value) Then If Cells(i, CL).Value > 0 Then cnt = cnt + 1 End If If Cells(i, CL).Value <> Cells(i, CL).Offset(1).Value And cnt > 1 Then Cells(i, CL).Offset(1).Resize(, 3).Insert Shift:=xlDown '3列挿入 With Cells(i + 1, CL) .Value = "小 計" .Offset(, 1).FormulaLocal = "=SUBTOTAL(9,R[-" & cnt & "]C:R[-1]C)" .Offset(, 2).FormulaLocal = "=SUBTOTAL(9,R[-" & cnt & "]C:R[-1]C)" End With i = i + 1: cnt = 0 ElseIf Cells(i, CL).Value <> Cells(i, CL).Offset(1).Value And cnt = 1 Then cnt = 0 End If End If i = i + 1 Loop Until Cells(i, CL).Value = "" With Cells(i, CL) .Value = "合 計" .Offset(, 1).FormulaLocal = "=SUM(R[-" & rng.Rows.Count & "]C:R[-1]C)" .Offset(, 2).FormulaLocal = "=SUM(R[-" & rng.Rows.Count & "]C:R[-1]C)" End With Application.ScreenUpdating = True Set rng = Nothing End Sub '//
その他の回答 (1)
- keithin
- ベストアンサー率66% (5278/7940)
sub macro1() dim r as long ’掃除 ブックを保存してからマクロを実行する事 range(range("A65536").end(xlup).offset(1), range("A65536")).entirerow.delete shift:=xlshiftup activeworkbook.save ’集計 range("A:K").subtotal _ groupby:=1, _ function:=xlsum, _ totallist:=array(10, 11), _ replace:=true, _ pagebreaks:=false, _ summarybelowdata:=true ’1行集計の検出と削除 activesheet.outline.showlevels rowlevels:=2 for r = range("A65536").end(xlup).row to 3 step -1 if rows(r).summary then if rows(r - 2).hidden = false then rows(r).delete shift:=xlshiftup end if end if next r ’表示の調整と片づけ activesheet.outline.showlevels rowlevels:=3 range("A:A").replace what:="*集計", replacement:="小計", lookat:=xlwhole range("A:A").font.bold = false range("A65536").end(xlup).entirerow.insert shift:=xlshiftdown range("A:K").clearoutline end sub >1支店1件しかない場合は行を挿入せずにこのままとしたい 1件しかない行を非常に見つけにくくなるため、そのようにはしないことを推奨します。
お礼
早速の回答ありがとうございました。希望どおりの結果を得ることができました。また,ピポットで集計するマクロを初めて確認することができましたので今後の参考とさせていただきます。
関連するQ&A
- エクセルで行を挿入し、小計、合計を出したい
質問いたします。 A列に支店コード(4桁の数値)、J列に金額、K列に手数料があります。 支店は5箇所でデータは1支店あたり100~500行ほどあります。全支店のデータが連続しています。 1.支店コードの最終行の下に1行挿入し、J列,K列の小計を計算する。 2.最後の支店の小計の下に一行あけてJ列,K列の合計をしたい。 どのようにしたら良いか教えてください。
- ベストアンサー
- Visual Basic
- 【エクセルマクロ】小計下への空白行挿入
マクロ初心者です。 日付ごとのデータがありまして、 webで検索した次のマクロを使って、 ' 1行目から処理開始(見出しなし) GYO = 1 Do While Cells(GYO, 1).Value <> "" ' 小計グループの先頭行→GYO1 GYO1 = GYO GYO = GYO + 1 ' 次の行から同じグループでない行を見つける Do While Cells(GYO, 1).Value = Cells(GYO1, 1).Value GYO = GYO + 1 Loop ' 同じグループの最終行→GYO2 GYO2 = GYO - 1 ' 小計行を挿入 Rows(GYO).Insert Cells(GYO, 2).Value = Cells(GYO1, 1).Value & "月の小計" Cells(GYO, 3).Value = " ********** " Cells(GYO, 6).FormulaR1C1 = "=SUBTOTAL(9,R" & GYO1 & "C:R" & GYO2 & "C)" Cells(GYO, 7).FormulaR1C1 = "=SUBTOTAL(9,R" & GYO1 & "C:R" & GYO2 & "C)" Cells(GYO, 8).FormulaR1C1 = "=SUBTOTAL(9,R" & GYO1 & "C:R" & GYO2 & "C)" GYO = GYO + 1 Loop ' 総合計 Cells(GYO, 2).Value = "年度合計" Cells(GYO, 3).Value = " ********** " Cells(GYO, 6).FormulaR1C1 = "=SUBTOTAL(9,R1C:R" & GYO2 & "C)" Cells(GYO, 7).FormulaR1C1 = "=SUBTOTAL(9,R1C:R" & GYO2 & "C)" Cells(GYO, 8).FormulaR1C1 = "=SUBTOTAL(9,R1C:R" & GYO2 & "C)" 次のように、小計と年度計を挿入できるのですが、 見にくいので、小計の下に1行挿入したいのです。 4/1 ○○○ ¥□□ | 4/30 ○○○ ¥□□ 4月の小計 **** ¥□□ 5/1 ○○○ ¥□□ | 5/31 ○○○ ¥□□ 5月の小計 **** ¥□□ 6/1 | (途中省略) 4/30 4月の小計 **** ¥□□ 年度計 **** ¥□□ マクロに詳しい方、アドバイスよろしくお願いします!
- ベストアンサー
- オフィス系ソフト
- エクセル マクロで行の合計を数値で入力したい
マクロ初心者です。 F列からAJ列までの合計をAK列に数値で入力しようとしています。 ただし、FからAJ列の各セルに全てデータは入っていません。 したがってFからAJ列のいずれかにデータが入っている最終行を 見つけて合計を算入しようとしているのですが下記の通りやっても うまくいきません。教えてください。 エクセルのバージョンは2002です。 Sub () 'データが入っている最終行まで合計額を数字で入力 LastRow = Cells(65536, COL).End(xlUp).Row For i = LastRow To 6 Step -1 Set myRange = Range(Cells(i, 6), Cells(i, 36)) Cells(i, 37).Value = WorksheetFunction.Sum(myRange) Next i End Sub
- ベストアンサー
- その他(ソフトウェア)
- 挿入した行のC列に式を挿入
Yahoo知恵袋からの回答の引用で Q エクセル マクロでデータごとに1行挿入するマクロを教えてください。 A~AW列にデータが入っていて、同じ品番ごとに1行挿入するマクロを教えてください。 A Sub insRow() Dim i As Long For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then Cells(i, 1).EntireRow.Insert (xlShiftDown) End If Next i End Sub このようなものがありますが、この最後のinsertにあたって、挿入されて新しく加わる全ての行のC列に式を挿入する方法(例えば、=A13等)を教えて頂けないでしょうか。
- ベストアンサー
- オフィス系ソフト
- Excelの集計表で固定していない小計があり、計算結果を上方の小計行に入れたい。
エクセル2K使用で300行程度の表があり、2行目まではタイトル行です。 A列 B列 C列(金額)2行目 あ 小計 60 い (空白) 10 う (空白) 20 え (空白) 30 お 小計 90 か (空白) 40 き (空白) 50 く 小計 400 ←計算が合いません け (空白) 60 こ (空白) 70 さ (空白) 80 し (空白) 90 す (空白) 100 カテゴリOffice系で上記の質問をいたしましたが、 "VBAで無いと難しいと思う"とアドバイスいただきましたので、 こちらで質問させていただきます。 VBAは超初心者ですが、色々の例題を検索し試行錯誤して下記マクロを 作成しましたが、一番下の小計が合いません宜しくお願いします。 Sub SYOUKEI() Dim i As Long Dim myLAST_ROW As Long Dim myTOP_ROW As Long Dim myBOTTOM_ROW As Long Dim myRANGE As Range With ActiveSheet myLAST_ROW = .Cells(Rows.Count, 1).End(xlUp).Row myTOP_ROW = 3 For i = myLAST_ROW To 1 Step -1 If .Cells(i, 2).Value = "小計" Then myBOTTOM_ROW = i + 1 Set myRANGE = _ .Range(.Cells(myTOP_ROW, 3), .Cells(myBOTTOM_ROW, 3)) .Cells(i, 3).Value = WorksheetFunction.Sum(myRANGE) myTOP_ROW = i - 1 End If Next i End With Set myRANGE = Nothing End Sub
- ベストアンサー
- Visual Basic
- エクセルで小計の累計
エクセル2007で、10行毎の小計行の下に累計行、その下に10行毎の小計行、その下に累計行 というように累計をだしていきたいと思っています。 途中の数行(小計行、累計行も含んだ)を削除することが多く、そうすると、数式がエラーになって 計算できなくなってしまいます。 N行おき 小計 累計 という感じで検索して MOD関数やROW関数を使ってみましたが、途中の行を削除するとうまくできません 途中の行を削除しても数式がエラーになることなく答えがでるようには無理でしょうか... 詳しい方どうか教えてください よろしくお願いします。 B列には項目C列には計算したい数字がはいっています 3行目から12行目までデータがはいっていて、 C列の13行目:3行目から12行目までの小計 C列の14行目:累計 C列の3行目から12行目までの合計 15列目から24行目までデータがはいっていて、 C列の25行目:15行目から24行目までの小計 C列の26行目:累計 C列の14行目+C列の25行目 26行目以降も100行目くらいまでデータと小計、累計のデータがあるのですが A、 B、 C 3 NO.1、りんご、10 4 NO.2、みかん、11 ・ ・ ・ 12 NO.10、ばなな、10 13 小計 37 14 累計 37 15 NO.1、りんご、3 16 NO.2、みかん、10 ・ ・ ・ 24 NO.10、ばなな、10 25 小計 40 26 累計 77 ・ ・ ・ 15から26行目を削除するとその次の累計の行がエラーになってしいます マクロとかそういったものを使わないと無理でしょうか... もしできたらすごく助かります。同じようなシートが何枚もあるので..
- ベストアンサー
- その他MS Office製品
- マクロで全てのシートで条件を満たすシートに行を挿入するにはどうしたらいいですか
マクロ初心者です。自分でも作ってみたのですが、なかなか思うようにいかず困っています。 book内のシート3つ目から最後のシートで、条件に一致するシートの特定位置に行を挿入するということがしたいのですが。 条件とは、1列目の最後の行に「合計」と記入されていれば、行を4行挿入し、上の書式をコピーするというものです。 下記に記しているマクロは、シートを指定した場合には動くのですが、これにシートをnとして、FOR...Nextを付け加えてシートを順番に参照させようとしても、うまくいきません。 Sub 行挿入sample3() With Sheets("10007") For i = 7 To .Cells(Rows.Count, 1).End(xlUp).Row If .Cells(i + 1, 1) = "" Then Exit For ElseIf .Cells(i + 1, 1) = "合計" Then Range(Cells(i + 1, 1), Cells(i + 4, 1)).Select Selection.EntireRow.Insert Range(Cells(i, 1), Cells(i, 3)).Select Selection.Copy Range(Cells(i + 1, 1), Cells(i + 4, 3)).PasteSpecial xlPasteFormats End If Next i End With End Sub 知識をお持ちの方、教えていただけるととても助かります。よろしくお願いします。
- ベストアンサー
- Visual Basic
- Excelで、小計欄がある場合の合計欄
小計欄がある場合の合計は小計を含めた値から、小計欄の額を引き去る必要があります。 しかし、引き去る列の名前を入力せねばならず、大きな表や行方向にも小計欄があると、ますます間違いやすくなります。 そこで、取り敢えずは小計の列や行を非表示にし、縦横の合計を求めること出来ませんか? なおOSはWin8.1、Excelは2013です。
- ベストアンサー
- Excel(エクセル)
- Excelの集計表で固定していない小計があり、計算結果を上位の小計行に入れたい
エクセル2K使用で300行程度の表があり、2行目まではタイトル行です。 品名L列 個数M列 単位N列 単価O列 金額P列 備考Q列← 2行目 完成品 1 組 (小計の計)(総合計) ← 3行目 小計 2 口 (O5:O8) (M*O) ← 4行目 品名A 2 個 10 20 ← 5行目 品名B 3 本 10 30 ← 6行目 品名C 2 個 5 10 ← 7行目 品名・ ・ ・ ・ 20 ← 8行目 品名・ ・ ・ ・ 20 ← 9行目 小計 (O :O ) (M*O) ←・行目 品名・ ・ ・ ・ ・ ←・行目 品名・ ・ ・ ・ ・ ←・行目 品名・ ・ ・ ・ ・ ←・行目 品名・ ・ ・ ・ ・ ←・行目 ・ ・ ・ ・ ・ ・ ←・行目 ・ ・ ・ ・ ・ ・ ←・行目 合計 (小計の計) L列の一番上の小計は固定です、2ツ目以降の小計は固定していません。 P列の金額を上位の小計列の単価に入力して再計算したい 合計はP列(表の最終行)の合計金額欄に表示したい、3行目完成品単価は合計 金額の(小計の計)と同じ金額です、3行目を見積書に転記したいと思っています。 集計表には空白セルが存在します。 宜しくお願いします。
- 締切済み
- オフィス系ソフト
- Excelの小計機能のマクロについて
Excelの小計機能をマクロで記録して、別のマクロにコードをコピペして使っています。 高頻度で小計が2回行われるんですが、どうしてでしょう?? あと、行が多いとすごく重くなり固まってしまいます。。 もし他にいいコードがあれば教えてください。 ちなみに、Excelの小計機能で、A列がグループの基準で、K列の値を合計しています。 よろしくお願い致します。
- 締切済み
- Visual Basic
お礼
動作結果もバッチリでした。当初参考にした質問・アドレスにあるマクロよりもわかりやすくその他にも応用がしやすいものと思います。ありがとうございました。