総合計の挿入ＶＢＡ

Question

添付ファイルの右の図のように
一番下に
総合計　を追加したいのですが。
わかる方おしえてくれませんでしょうか
各月の金額の総合計です。
28行　Ｌ列に合計値

めぐみん_ · Accepted Answer

＞月ごとに品番の数が変わります。

月毎ってどの集団を指しているのでしょう？
『売上月』かと思えば、とても『日付』とは思えないですし、まして

＞各月の金額の総合計です。
＞28行　Ｌ列に合計値

ならば尚更『？？？？』ですね。
単に『月別シートにあるデータ区分の最終行から２行下に書き足したい』って感じならわかりますけど。

それとこの類似している質問で左右に表が存在してますが、実際は片方だけなのではないのでは？
なので今回は『Ｌ列に』とありますが実は『Ｆ列』だったり？

一応Ｆ列であると仮定して過去の回答を弄りました。
https://oshiete.goo.ne.jp/qa/11182920.html
の一部を変えて、

Dim sosum As Long  '最初に宣言

'~略~

sosum = 0

For Each R In Range("f4", Cells(Rows.Count, "f").End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers).Areas

With R.Resize(1)
if .Row > 4 Then .Offset(-1 , -4).Resize( , 5).Value = Range("B3:F3").Value

With .Offset(R.Rows.Count)
.Offset(, -1).Value = "合計"
.Value = WorksheetFunction.Sum(R)
sosum = sosum + .Value '個々の集団の合計を加算していく
End With

With .CurrentRegion
.Borders.LineStyle = 2
.BorderAround LineStyle = xlcontiuous
End With

End With

とかかな？
Excel自体で検証してないのでミスってたらごめんなさい。

30246kiku · Answer

＃６です

> "=SUM(R[-{%1}]C:R[-1]C)"
> Replace(CF, "{%1}", i)　　　　
> "{%1}"の意味がわかりません。

"{%1}" は、単に置き換える文字列を指定しているだけです

この式は、各表下の 合計 右側に設定するものになります

例えば、

F8 に設定する時には、同じ列の４行前から１行前まで
"=SUM(R[-4]C:R[-1]C)"　を設定します

F16 に設定する時には、同じ列の５行前から１行前まで
"=SUM(R[-5]C:R[-1]C)"　を設定します

この式の異なる部分は、4 → 5 の所だけ
置換えやすいように、その部分を {%1} としていただけです

何行前････変数 i に作ってました

必要あれば、処理の内容解説しますが････
押し付けはしません

めぐみん_ · Answer

No.5です。

No.5のリンク先はミスってました。
大元は
https://oshiete.goo.ne.jp/qa/11181938.html
こちらのグループ分けからですね。

30246kiku · Answer

まとめて処理してみた添付画像、左側　→　右側に処理対象は、アクティブシート（結果は上書き）出来上がったものを対象に、再度実行しても変化なし･･･のハズどうなりますか Option Explicit Public Sub Samp1() 　　Dim rng As Range, r As Range, rL As Range 　　Dim vS As Variant, vG As Variant 　　Dim i As Long 　　Const CF As String = "=SUM(R[-{%1}]C:R[-1]C)" 　　Const CLM As String = "総合計" 　　Const CSM As String = "合計" 　　Application.ScreenUpdating = False 　　With ActiveSheet 　　　　Set r = .Range("E1").End(xlDown) 　　　　While (r.Row < Rows.Count) 　　　　　　If (r.Value <> CLM) Then 　　　　　　　　With r.CurrentRegion 　　　　　　　　　　i = .Rows.Count 　　　　　　　　　　If (r.Value = "単価") Then 　　　　　　　　　　　　If (rng Is Nothing) Then 　　　　　　　　　　　　　　Set rng = .Rows(1) 　　　　　　　　　　　　End If 　　　　　　　　　　　　i = i - 1 　　　　　　　　　　ElseIf (Not rng Is Nothing) Then 　　　　　　　　　　　　rng.Copy .Cells(0, 1) 　　　　　　　　　　End If 　　　　　　　　　　If (r.Offset(1).Value <> "") Then 　　　　　　　　　　　　Set r = r.End(xlDown) 　　　　　　　　　　End If 　　　　　　　　　　If (r.Value = CSM) Then 　　　　　　　　　　　　i = i - 1 　　　　　　　　　　Else 　　　　　　　　　　　　Set r = r.Offset(1) 　　　　　　　　　　　　r.Value = CSM 　　　　　　　　　　End If 　　　　　　　　　　r.Offset(, 1).FormulaR1C1 = Replace(CF, "{%1}", i) 　　　　　　　　　　vS = vS + WorksheetFunction.Sum(.Columns(3)) 　　　　　　　　　　vG = vG + r.Offset(, 1).Value 　　　　　　　　End With 　　　　　　　　r.CurrentRegion.Borders.LineStyle = xlContinuous 　　　　　　　　Set rL = r 　　　　　　End If 　　　　　　Set r = r.End(xlDown) 　　　　Wend 　　　　If (Not rL Is Nothing) Then 　　　　　　rL.Cells(3, 0).Resize(, 3).Value = Array(vS, CLM, vG) 　　　　　　.Columns.AutoFit 　　　　End If 　　End With 　　Application.ScreenUpdating = True End Sub 今回専用にするのなら数量の合計は D 列を SUM すれば金額の合計は F 列を SUM して ÷２するか SUMIF で、E 列が "合計" の所の F 列を求めれば･･･

めぐみん_ · Answer

No.1(3はほっといて）です。

結局のところ
https://oshiete.goo.ne.jp/qa/11182075.html
このリンク先の左表が元々の状態ですよね？
そこに集団毎に『”合計”と”タイトル”』を付け足して、且つ今回の質問につなげたいと言う事ではないのかな？
それとも質問毎にプロシージャ―を分けて作成したいのか・・・？

ところで数量の総合計には２つの捉え方があります。

・品番を無視した数量の総合計
・品番毎に合計を出して一覧にする

前者は余り意味はない気がしますけどそれを求めているのか、後者は品番毎に管理できる（ある月の品番毎の売り上げ数を知ることが出来る）と思いますけど。
それに品番毎の小計も出せますしね。（でも品番が同じでも単価が違う場合がある？）

さてさてどちらが目的でしょうか？

WindFaller · Answer

今の所、表の塊が2つま場合に限ります。右革に増えていくようなら、もう一度手直しします。

No.2 の最後尾の
　　.Offset(, -1).Value = "総合計"
　End With
　Call QuantitiesTotal '← ここにこれを入れる
End Sub

Sub QuantitiesTotal()
  Dim c As Range, r As Range, c1 As Range
  Dim Rng As Range
  Dim QTotal As Double
  Dim lstC

Set c = Cells.Find(What:="数量*", After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows)　'右方向に探していきます。

Set Rng = Range(c, Cells(Rows.Count, c.Column).End(xlUp))
  QTotal = Application.Sum(Rng)
  Set c1 = c
  Set c = ActiveSheet.UsedRange.Find(What:="数量*", After:=c, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows)
  If Not c Is Nothing And Not c Is c1 Then
　Set Rng = Range(c, Cells(Rows.Count, c.Column).End(xlUp))
　If Rng.Cells(Rng.Count).Offset(, -1).Value = "総数量" Then '誤動作を防ぐため
　  Set Rng = Rng.Resize(Rng.Count - 1)
　 End If
　QTotal = Application.Sum(Rng) + QTotal
  End If
  Set r = ActiveSheet.UsedRange.Find(What:="総合計*", After:=c, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns)
  With r
　.Offset(, -1).Value = QTotal
　.Offset(, -2).Value = "総数量"
  End With
End Sub

p.s. 作った後に気がついたけれども、数式をおいたほうが無難だったかなって思います。

めぐみん_ · Answer

No.1です。

”合計”と言う文字でやる方法もありましたね。
私ならSUMIF関数で、

Dim sosum As Long

'~略~

'~For~Next~

With Range("e4", Cells(Rows.Count, "e").End(xlUp))

sosum = WorksheetFunction.SumIf(Range(.Address), "合計", .Offset(, 1))

.Offset(.Rows.Count + 1).Resize(1, 2).Value = Array("総合計", sosum)

End With

こうしますかね。（No.1と同様左に表があると仮定して。）

WindFaller · Answer

合計という文字を探して、その左側が合計の数値があるとします。
文字がなければ、探せません。

'//
Sub TotalFinds()
　Dim Rng As Range
　Dim c As Range
　Dim dTotal As Double
　Dim col As Long
　Dim rw As Long
　Dim FirstAddress As String
　Set Rng = ActiveSheet.UsedRange
　'合計の文字を探す
　Set c = Rng.Find("合計*", , xlFormulas, xlWhole)
　If Not c Is Nothing Then
　　FirstAddress = c.Address
　　Do
　　　dTotal = dTotal + c.Offset(, 1).Value
　　　Set c = Rng.FindNext(c) '
　　Loop While Not c Is Nothing And c.Address <> FirstAddress
　End If
 
　'書き出す場所を探す(上部のデータの始まりの行が重要です）
　col = Cells(3, Columns.Count).End(xlToLeft).Column
　rw = Cells(Rows.Count, col).End(xlUp).Row
　With Cells(rw + 2, col)
　　.Value = dTotal
　　.Offset(, -1).Value = "総合計"
　End With
End Sub

総合計の挿入ＶＢＡ

＃６です

No.5です。

まとめて処理してみた

No.1(3はほっといて）です。

今の所、表の塊が2つま場合に限ります。

No.1です。

合計という文字を探して、その左側が合計の数値があるとします。

＞月ごとに品番の数が変わります。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング