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

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

No.3 ベストアンサー 回答者： imogasi 回答日時： 2004/06/24 19:17

#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

この回答へのお礼

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

お礼日時：2004/06/28 03:29

No.2 回答者： papayuka 回答日時： 2004/06/24 08:27

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

この回答へのお礼

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

お礼日時：2004/06/28 03:31

No.1 回答者： imogasi 回答日時： 2004/06/24 07:03

朝時間がないので、とりあえず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/110
2004/5/211
2004/5/312
2004/5/3　19
2004/6/413
2004/6/514
（結果）Ｓｈｅｅｔ２のＡ１：Ｂ６
2004年1月3
2004年2月7
2004年3月11
2004年4月15
2004年5月42
2004年6月27