A列で同じ日付をグループ化し、B列の金額の総計を出したいのですが

質問

エクセルVBAでA列で同じ月をグループ化し、B列の金額の総計を出し、別のシートの1月、2月、3月・・・・とある列に1月は1月の金額合計、2月は2月の金額合計と貼り付けたいのですが、頭が悪いもので、うまくできません。どなたかお解かりになる方よろしくお願い致します。

回答No.3

imogasi · ベストアンサー

#1です。別解を上げます。ソートを利用しません。
素のシートデータもそのままです。順序もどのように
出現してもＯＫです。Ａ列は日付シリアル値であること。
文字列日付だと少し変える必要あり。
インデックス法とでも言いましょうか。
＃１よりコードが短いです。
データのない月の行が空白になりますが。
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
'---------Sheet1の行数察知
d = sh1.Range("A1").CurrentRegion.Rows.Count
'------sheet2のＡ列をクリア
For i = 1 To 30
sh2.Cells(i, "A") = ""
Next i
'----最下ｄ行まで、所定の行を年月から割だし
For i = 1 To d
yi = Year(sh1.Cells(i, "A"))
mi = Month(sh1.Cells(i, "A"))
x = (yi - 2004) * 12 + mi
'----Ｓｈｅｅｔ２の割出した行にＳｈeｅｔ１の計数加算
If sh2.Cells(x, "A") = "" Then
　　sh2.Cells(x, "A") = yi & "年" & mi & "月"
sh2.Cells(x, "B") = 0
End If
sh2.Cells(x, "B") = sh2.Cells(x, "B") + sh1.Cells(i, "B")
Next i
End Sub

お礼

お礼が遅れまして申し訳ございません。大変参考になりました。また、よろしくお願い致します。

回答No.2

papayuka

A1にタイトル「日付」、B1にタイトル「金額」のある下記のようなデータとして、表示に拘らないならVBAを使わなくてもピボットテーブルとグループ化で求めたいものは出ると思います。

日付　　　　金額
2004/1/1　　1000
2004/1/2　　2000
2004/2/1　　1500
2004/2/2　　2000
2004/3/1　　2500
2004/3/2　　1000

マクロ化するとこんな感じかな？
試すならテスト環境で。

Sub Test()
Dim myPivot As PivotTable
　ActiveSheet.Range("A1").Activate
　Set myPivot = ActiveSheet.PivotTableWizard(SourceType:=xlDatabase, _
　　　　　　　　SourceData:=ActiveSheet.Range("A1").CurrentRegion)
　myPivot.AddFields RowFields:="日付"
　myPivot.PivotFields("金額").Orientation = xlDataField
　myPivot.PivotSelect "日付[すべて]", xlLabelOnly
　Selection.Group
　ActiveCell.Select
End Sub

お礼

御礼が遅れましてすみません。参考になりました。またよろしくお願い致します。

回答No.1

imogasi

朝時間がないので、とりあえずSheet1上でソートしてしまってますが、素シートデータをそのままにしたいなら、別シートにコピーするステップを入れてください。
ソート利用法という解法タイプです。
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
Selection.Sort Key1:=sh1.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
d = sh1.Range("A1").CurrentRegion.Rows.Count
' MsgBox d
t = sh1.Cells(1, "B")
ym = Year(sh1.Cells(1, "A"))
mm = Month(sh1.Cells(1, "A"))
j = 1
For i = 2 To d
yi = Year(sh1.Cells(i, "A"))
mi = Month(sh1.Cells(i, "A"))
ymm = ym & mm
'----
If ymm = yi & mi Then
t = t + sh1.Cells(i, "B")
Else
sh2.Cells(j, "A") = ym & "年" & mm & "月"
sh2.Cells(j, "B") = t
t = 0
j = j + 1
'------
t = t + sh1.Cells(i, "B")
ym = yi
mm = mi
End If
Next i
sh2.Cells(j, "A") = ym & "年" & mm & "月"
sh2.Cells(j, "B") = t
End Sub
(素データ）Ｓｈｅｅｔ１のＡ１：Ｂ１４のソート後。
2004/1/23 　1
2004/1/24 　2
2004/2/25　3
2004/2/26 　4
2004/3/27 　5
2004/3/28　6
2004/4/29　7
2004/4/30 　8
2004/5/1 10
2004/5/2 11
2004/5/3 12
2004/5/3　19
2004/6/4 13
2004/6/5 14
（結果）Ｓｈｅｅｔ２のＡ１：Ｂ６
2004年1月 3
2004年2月 7
2004年3月 11
2004年4月 15
2004年5月 42
2004年6月 27