合計の計算

質問

添付資料のような表に合計を計算させる構文を教えて下さい。
K,L,M 列について、月々の合計をA～I列に示す表に入れたいです。

回答No.4

pkh4989 · ベストアンサー

こんにちは。
不具合が有るかも知れませんが、試してみてください。
Type wTBL
　　GOODS()　　 As String
　　KIN()　　　 As Double
　　cnt　　　　 As Integer
End Type
Dim Sum(12)　　 As wTBL

Sub 月別集計()
　　Dim wR　　　　　As Long
　　Dim wI　　　　　As Long
　　Dim wM　　　　　As Integer
　　Dim wS　　　　　As String
　　Dim fFlg　　　　As Boolean
　　Dim eR　　　　　As Long
　　'
　　Erase Sum
　　SumCnt = 0
　　With ActiveSheet
　　　　'集計処理
　　　　For wI = 2 To .Range("K" & Rows.Count).End(xlUp).Row
　　　　　　fFlg = False
　　　　　　wM = .Cells(wI, "K")　　　　'月
　　　　　　wS = .Cells(wI, "L")　　　　'商品
　　　　　　For wY = 1 To Sum(wM).cnt
　　　　　　　　If Sum(wM).GOODS(wY) = wS Then
　　　　　　　　　　fFlg = True
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next
　　　　　　If fFlg Then
　　　　　　　　'ワークテーブルに商品が存在する時
　　　　　　　　Sum(wM).KIN(wY) = Sum(wM).KIN(wY) + .Cells(wI, "M")
　　　　　　Else
　　　　　　　　'ワークテーブルに商品が存在しない時
　　　　　　　　Sum(wM).cnt = Sum(wM).cnt + 1
　　　　　　　　ReDim Preserve Sum(wM).GOODS(Sum(wM).cnt)
　　　　　　　　ReDim Preserve Sum(wM).KIN(Sum(wM).cnt)
　　　　　　　　Sum(wM).GOODS(Sum(wM).cnt) = wS
　　　　　　　　Sum(wM).KIN(Sum(wM).cnt) = Sum(wM).KIN(Sum(wM).cnt) + .Cells(wI, "M")
　　　　　　End If
　　　　Next
　　　　'
　　　　'展開処理(A列に商品名を設定してもしなくても処理出来ます)
　　　　'A列に商品名が設定されていない時は商品名を設定しながら展開します
　　　　eR = 2
　　　　For wI = 4 To 11　　　　　　　　'４月～１１月
　　　　　　For wY = 1 To Sum(wI).cnt　 '月別商品件数
　　　　　　　　wR = .Range("A" & Rows.Count).End(xlUp).Row
　　　　　　　　If wR < 3 Then
　　　　　　　　　　eR = eR + 1
　　　　　　　　　　.Cells(eR, 1) = Sum(wI).GOODS(wY)
　　　　　　　　　　.Cells(eR, wI - 2) = Sum(wI).KIN(wY)
　　　　　　　　Else
　　　　　　　　　　fFlg = False
　　　　　　　　　　For wZ = 3 To wR
　　　　　　　　　　　　If .Cells(wZ, 1) = Sum(wI).GOODS(wY) Then
　　　　　　　　　　　　　　fFlg = True
　　　　　　　　　　　　　　Exit For
　　　　　　　　　　　　End If
　　　　　　　　　　Next
　　　　　　　　　　If fFlg Then
　　　　　　　　　　　　.Cells(wZ, wI - 2) = Sum(wI).KIN(wY)
　　　　　　　　　　Else
　　　　　　　　　　　　eR = eR + 1
　　　　　　　　　　　　.Cells(eR, 1) = Sum(wI).GOODS(wY)
　　　　　　　　　　　　.Cells(eR, wI - 2) = Sum(wI).KIN(wY)
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　Next
　　　　Next
　　End With
End Sub

回答No.3

mt2008

手抜きマクロで、No.1と同じ事を…

Sub Sample()
　Application.ScreenUpdating = False
　Range("B3").Formula = "=SUMPRODUCT(($K$2:$K$6=B$2)*($L$2:$L$6=$A3)*$M$2:$M$6)"
　Range("B3").Copy
　Range("B3:H7").Select
　ActiveSheet.Paste
　Selection.Copy
　Selection.PasteSpecial Paste:=xlPasteValues
　Application.CutCopyMode = False
　Application.ScreenUpdating = True
End Sub

回答No.2

ShowMeHow

エクセルをほとんど使ったことがないので詳細はわかりませんが、
「ピボットテーブル」を使ったらどうでしょうか？

参考URL：

http://dreamy.boy.jp/tec2_29.htm

回答No.1

mt2008

B3に↓を入れてB3:H7にコピー
=SUMPRODUCT(($K$2:$K$6=B$2)*($L$2:$L$6=$A3)*$M$2:$M$6)
0を表示したくない場合は、条件付書式で０の時の文字色を白にしてください。

補足

マクロで書くとどうなるのでしょうか？
Ｋ列が何千行もあるのでマクロで処理できればと思っています。