![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
No.3ベストアンサー
- 回答日時:
#1です。
別解を上げます。ソートを利用しません。素のシートデータもそのままです。順序もどのように
出現してもOKです。A列は日付シリアル値であること。
文字列日付だと少し変える必要あり。
インデックス法とでも言いましょうか。
#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のA列をクリア
For i = 1 To 30
sh2.Cells(i, "A") = ""
Next i
'----最下d行まで、所定の行を年月から割だし
For i = 1 To d
yi = Year(sh1.Cells(i, "A"))
mi = Month(sh1.Cells(i, "A"))
x = (yi - 2004) * 12 + mi
'----Sheet2の割出した行にSheet1の計数加算
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
- 回答日時:
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
- 回答日時:
朝時間がないので、とりあえず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
(素データ)Sheet1のA1:B14のソート後。
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
(結果)Sheet2のA1:B6
2004年1月3
2004年2月7
2004年3月11
2004年4月15
2004年5月42
2004年6月27
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel で行を指定回数だけコピ...
-
vbaでコントロールブレイク
-
excelの差込印刷で可視セルだけ...
-
歯抜けの時間を埋めて行の挿入
-
【VBA】UserForm1の中で使うワ...
-
Excel VBA インデックスの境...
-
Excel VBA 複数条件にマッチし...
-
エクセル:VBAで月変わりで、自...
-
エクセルVBAで 2種のリストを...
-
エクセルのマクロで会社別・商...
-
エクセルVBA 別シートの複数の...
-
Excelマクロ データが上書きさ...
-
VBAで複雑な構成の転記
-
Excelについて質問します。 英...
-
スマホ機種変更で旧機種のGoogl...
-
携帯修理出して戻ってきたら、L...
-
スマホにPCから音楽を入れたい...
-
外付けHDDをフローリングに落と...
-
代替機にキズ
-
携帯メモリーカード
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel で行を指定回数だけコピ...
-
excelの差込印刷で可視セルだけ...
-
エクセルVBA 別シートの複数の...
-
Excel VBA インデックスの境...
-
VBA:同じ文字列データの比...
-
エクセル:VBAで月変わりで、自...
-
VBA別シートの最終行の下行へ貼...
-
エクセルVBAで 2種のリストを...
-
EXCELマクロで全シート対...
-
歯抜けの時間を埋めて行の挿入
-
エクセルVBAで SendKeys "{TAB}"
-
VBAで条件が一致する行のデータ...
-
Excel VBAでシート内全体に非表...
-
VBA 貼付先範囲(行)がいっぱ...
-
VBAで複数シート選択
-
Excelマクロ データが上書きさ...
-
Excel VBA 複数条件にマッチし...
-
VBAの処理が途中で止まる
-
VBAで複雑な構成の転記
-
エクセル2007で、マクロで、結...
おすすめ情報