Excelの集計表で固定していない小計があり、計算結果を上方の小計行に入れたい

このQ&Aのポイント
  • Excelの集計表で固定していない小計があり、計算結果を上方の小計行に入れたい方法について教えてください。
  • エクセル2K使用で300行程度の表があり、2行目まではタイトル行です。
  • VBAを使用して小計の計算を行い、結果を上方の小計行に入れる方法について教えてください。
回答を見る
  • ベストアンサー

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

  • kts59
  • お礼率75% (3/4)

質問者が選んだベストアンサー

  • ベストアンサー
  • okormazd
  • ベストアンサー率50% (1224/2412)
回答No.3

申し訳ありません。 あなたのにあったのを落としてしまいました。 With ActiveSheet の下に myLAST_ROW = .Cells(Rows.Count, 1).End(xlUp).Row を入れてください。

kts59
質問者

お礼

okormazd 様 目的通りの動きを確認できました。 私の知識不足で、どのように操作して、どのように動作しないのか うまく言葉で説明できなかったことが原因であると心得ております。 初心者とはこんなもんだと思って、どうか、お気を悪くなさらずに 今後ともご指導お願いいたします。 ありがとうございました、取り急ぎ 御礼まで。

その他の回答 (2)

  • okormazd
  • ベストアンサー率50% (1224/2412)
回答No.2

#1です。 同じmoduleの中に同じ名前のsubがなければ貼り付けて実行するだけです。

kts59
質問者

補足

#1様 >同じmoduleの中に同じ名前のsubがなければ貼り付けて実行するだけです。 新規Excelファイルに貼り付けて実行等も試みましたが myBOTTOM_ROWには代入が"0"のままで、 myTOP_ROWには"Nothing"が返ってしまいます、 勿論データは同じ集計表を入れています。 VBAの基本が分かっていませんのでお許し下さい。 2~3日勉強し、質問かお礼の返事を致しますので、お気付きになられましたら ご教授お願いします。

  • okormazd
  • ベストアンサー率50% (1224/2412)
回答No.1

実行していないから、危険だけど、 下記のようなもの。 Sub SYOUKEI() Dim i As Integer Dim myLAST_ROW As Integer Dim myTOP_ROW As Integer Dim myBOTTOM_ROW As Integer Dim myRANGE As Range With ActiveSheet myBOTTOM_ROW = myLAST_ROW For i = myLAST_ROW To 3 Step -1 If .Cells(i, 2).Value = "小計" Then myTOP_ROW=i+1 Set myRANGE = _ .Range(.Cells(myTOP_ROW, 3), .Cells(myBOTTOM_ROW, 3)) .Cells(i, 3).Value = WorksheetFunction.Sum(myRANGE) myBOTTOM_ROW = i - 1 End If Next i End With Set myRANGE = Nothing End Sub

kts59
質問者

お礼

早速のご回答ありがとうございます。 教えていただいたマクロを貼り付け以外に何か手続きが必要でしょう? なにせ、超初心者なので理解できなくてすみません。

関連するQ&A

  • Excelの空白行を上に詰めるVBAについて

    Excelにて特定の列のみの空白を上に詰めるVBAを組んだのですが、 全ての列に適用してしまって困っております。 Sub 空白を上に詰める() Dim Lrow, i As Long Dim myRange As Range Lrow = Range("AH65536").End(xlUp).Row Set myRange = Rows(Lrow + 1) For i = 1 To Lrow If Cells(i, 34) = "" Then Set myRange = Union(myRange, Rows(i)) End If Next i myRange.Delete End Sub 上記のように「AH」列にのみ適用するように組みましたが、 うまくいきません。 VBAは初心者レベルです。 VBAにお詳しい方のご意見をお聞かせ願えますでしょうか。 宜しくお願い致しますm(_ _)m

  • 重複行を完全削除するエクセルのマクロ

    Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 13).Value = Cells(ii, 13).Value Then Delete Shift:=xlUp End If Next ii Next i End Sub マクロに関しては、素人でございます。 こちらのマクロを作ってみたのですがうまくいきません。 4列目と13列目の列が重複したときのみ重複した行をすべて削除させたいと思っております。どうぞお教えください。

  • マクロで小計行を入力する方法

    はじめまして。 過去問を検索したのですが、よく分からなかったので質問させていただきます。 数日前にマクロの練習をし始めたばかりで、分からないことが多々あるのですが、ある表を練習で作っていて詰まってしまいました。 番号  月日  会社名  金額 1   11/1   A社   100 2   11/5   A社   200 3   11/4   B社   150 4   11/9   C社   300 このような表があるとして 番号  月日  会社名  金額 1   11/1   A社   100 2   11/5   A社   200   <空白行3行> 3   11/4   B社   150   <空白行3行> 4   11/9   C社   300  ※空白行が3行なのは、印刷した時に会社ごとの境目を見やすくする為です。 この表をマクロを使って自動で会社ごとの境目に空白行を挿入するまではできました。 この後、金額の下に会社ごとの小計を出したいのです。 毎月各社の項目数が変化するので、小計欄を固定することが出来ません。 なので、引数の設定で詰まってしまっています。 色々なサイト様を回って myLAST_ROW = Cells(Rows.Count, 2).End(xlUp).Row myTOP_ROW = 2 myBOTTOM_ROW = i - 1 Set myRANGE = _ Range(Cells(myTOP_ROW, 4), Cells(myBOTTOM_ROW, 4)) Cells(i, 4).Formula = "=SUM(" & myRANGE.Address & ")" myTOP_ROW = i + 1 というのが自分の思う内容に一番近いところまでいったのですが、 番号  月日  会社名  金額 1   11/1   A社   100 2   11/5   A社   200              300   3   11/4   B社   150              450 4   11/9   C社   300              750 のようになってしまいます。 直前のVBAはこうなっています(実際はこの前にページ設定などが入っています)。 For i = Cells(Rows.Count, myCol).End(xlUp).Row To 3 Step -1 If Cells(i, myCol) <> Cells(i - 1, myCol) Then Rows(i).Insert Rows(i).Insert Rows(i).Insert 素人の文面で大変見づらく、そして分かりにくくて申し訳ないのですが、ご教授頂ければ幸いです。

  • エクセルで行を挿入して小計合計を出したい

    質問ですが,以下の参考としたマクロについて,データが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

  • エクセル 連番を付ける

    A列に連番を付けたいと思います。 3行目から始める方法教えて下さい。 Dim i As Long For i = 1 To Range("A65536").End(XlUp).Row Cells(i,1).Value = i Next i

  • 重複行を完全削除するエクセルのマクロ

    Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 2).Value = Cells(ii, 2).Value _ And Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 5).Value = Cells(ii, 5).Value Then Dim iii As Byte iii = 1 Rows(ii).Delete Shift:=xlUp End If Next ii If iii = 1 Then Rows(i).Delete Shift:=xlUp iii = 0 Next i End Sub データーが下の表のように入っております。     A    B    C    E    F 1  1/26  a1234  fdsa  5000  C1 2  1/27  a4567  sdfa  4000  T2 3  1/28  a1234  dfsa  5000  C1 4  1/30  b4567  asdf  6600  A2 5  2/10  b4567  fsda  6600  A2 6  2/10  a1234  afds  5000  C1 B列、E列、F列が完全一致(重複1行目と3行目と6行目・4行目と5行目)で削除し結果的に2行目だけ残る方法がしたいのですが、このマクロですと少ないデータですとうまく動くのですが、『大量のデータを一気に削除出来ない』、『同じ重複が3つ以上のデータが多数ある場合データが削除されずに残ってしまう』エラーが出てしまいます。どうかお教えください。

  • エクセルで集計表を作成するマクロで悩んでいます。

    エクセルで集計表を作成するマクロで悩んでいます。 日付ごとにシート別に分かれたデータを「集計表」として新しいシートに集めたいと思っています。 ●元データに関して  1行目は空欄  2行目は表の名前  3行目は日付  4~7行目は番号・数量などの項目  8行目から多い場合で50行目くらいまで番号ごとの情報が並んでいます。  AC列まで並んでいます。・・・・・・●画像左上が元データ ●このファイルから、(1)集計表という新しいシートを作成して(2)そのファイルに日付ごとの データが下方向に集まるように集計したいと思っています。 そこで、次のVBAを作成しました。 Sub 集計表() Dim ws As Worksheet For Each ws In Worksheets ’AD列にシート名を入れる ws.Range("AD1:AD100").Value = ws.Name Next ws Dim newSh As String Dim Sh As Worksheet, myFlag As Boolean newSh = "集計表" myFlag = False For Each Sh In ThisWorkbook.Worksheets If Sh.Name = newSh Then myFlag = True '----全データシートのデータをクリアし、先頭へ移動します Worksheets(newSh).Cells.ClearContents Worksheets(newSh).Move before:=Sheets(1) Exit For End If Next Sh '----全データシートを先頭へ追加します If myFlag = False Then ActiveWorkbook.Worksheets.Add(before:=Worksheets(1)).Name = newSh End If Worksheets(2).Select Rows("1:1").Select Application.CutCopyMode = False Selection.Copy Sheets("集計表").Select ActiveSheet.Paste Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long Application.ScreenUpdating = False '----列見出しをコピーします Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1") For i = 2 To Worksheets.Count With Worksheets(i) lRow = .Cells(Rows.Count, 1).End(xlUp).Row lCol = .Cells(1, Columns.Count).End(xlToLeft).Column '----シートのデータが8行以上の場合にコピーします If lRow >= 8 Then lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 .Activate .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1) End If End With Next i Worksheets(1).Activate Range("A1").Select Application.ScreenUpdating = True End Sub この方法だと、「番号」などを含むシートごとの全ての情報がコピーされてしまいます。 ●左下画像 これを「(1)1枚目のシートの1行目から7行目(2)1枚目シートの8行目からA列に1以上の番号が 入っている行(3)2枚目シートの8行目からA列に1以上の番号が入っている行(4)3枚目シートの・・・」というように全てのシートに対して集計することはできないでしょうか。 ●右下画像 VBAを始めたばかりなので、まだ、あまり理解できていません。

  • 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行目を見積書に転記したいと思っています。 集計表には空白セルが存在します。 宜しくお願いします。

  • 【VBA】"オブジェクトが必要です"メッセージ出力

    VBAを使用し、A列に日付、B列に数量、C列に単価、D列に金額を入力し、 数量*単価にて、金額を求めるVBAを作成しています。 そこまでは上手くいくのですが、D列で求めた金額を最終行で合計する事で 躓いてしまっています。 行は常に追加され可変の為、最終行を「Cells(Row.Count, 1).End(xlUp).Row」 にて引っ張ってこようと思っております。以下のようなVBAを記載しましたが、 「オブジェクトが必要です」とのメッセージがでて、処理が上手くいきません。 どのような問題があるのか、お分かりの方、ご回答頂けますと幸いです。 ■環境  Windows7  Excel2010 ■VBA Sub test() Dim i As Long Dim j As Long Dim k As Long For i = 2 To Cells(Row.Count, 1).End(xlUp).Row Cells(i, 4) = Cells(i, 2) * Cells(i, 3) Next j = Cells(Row.Count, 1).End(xlUp).Row + 1 k = Cells(j, 1).End(xlUp).Row Cells(j, 4) = WorksheetFunction.Sum(Cells(2, 4), Cells(k, 4)) End Sub

  • VBAでの行集計

    VBAでの行集計 いつもお世話になっております 今 マクロでの行集計で困っております。 お力をお貸し下さい m(__)m したいことは B列最終セルを見つけ出し 列の合計を出す 合計を右横最終セルまでコピーする 最終はR列までです そこで下記のマクロで合計は出しました Dim BeforePos As Long BeforePos = Range("B4").End(xlDown).Row Cells(BeforePos + 1, 2).Formula = "=SUM(B4:B" & BeforePos & ")" このセルの数式を右最終列までコピーをしたい それだけのことですがうまくいきません どうかよろしくお願いします