VBA 辞書で年度別月集計
辞書で年度別月集計Sub test()' 辞書で年度別月集計 Dim wsSrc As Worksheet Dim wsDst As Worksheet Dim dict As Object Dim r As Long, lastRow As Long Dim dt As Date, y As Integer, m As Integer Dim key As String Dim i As Integer Dim startYear As Integer Dim endYear As Integer ' シート設定 Set wsSrc = ThisWorkbook.Sheets("Data") On Error Resume Next Set wsDst = ThisWorkbook.Sheets("Summary") On Error GoTo 0 If wsDst Is Nothing Then Set wsDst = ThisWorkbook.Sheets.Add wsDst.Name = "Summary" End If wsDst.Cells.Clear ' データ最終行取得 lastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row ' 辞書で月ごと集計 Set dict = CreateObject("Scripting.Dictionary") For r = 2 To lastRow If IsDate(wsSrc.Cells(r, "A")) Then dt = wsSrc.Cells(r, "A").Value y = Year(dt) m = Month(dt) ' 年度判定（4月～翌年3月） If m >= 4 Then key = y & "-" & Format(m, "00") Else key = (y - 1) & "-" & Format(m, "00") End If If Not dict.exists(key) Then dict.Add key, Array(0, 0) End If Dim arr arr = dict(key) arr(0) = arr(0) + val(wsSrc.Cells(r, "B").Value) arr(1) = arr(1) + val(wsSrc.Cells(r, "C").Value) dict(key) = arr End If Next r ' 対象年度の範囲決定（最新データから） Dim maxDate As Date maxDate = Application.Max(wsSrc.Range("A2:A" & lastRow)) startYear = Year(maxDate) If Month(maxDate) < 4 Then startYear = startYear - 1 endYear = startYear + 1 ' 見出し wsDst.Range("A1").Value = "年月" wsDst.Range("B1").Value = "借方合計" wsDst.Range("C1").Value = "貸方合計" ' 出力 Dim rowOut As Long rowOut = 2 For i = 4 To 15 ' 4月～翌年3月 Dim outputYear As Integer, outputMonth As Integer If i <= 12 Then outputYear = startYear outputMonth = i Else outputYear = startYear + 1 outputMonth = i - 12 End If key = startYear & "-" & Format(outputMonth, "00") wsDst.Cells(rowOut, 1).Value = outputYear & "年" & Format(outputMonth, "00") & "月" If dict.exists(key) Then wsDst.Cells(rowOut, 2).Value = dict(key)(0) wsDst.Cells(rowOut, 3).Value = dict(key)(1) Else wsDst.Cells(rowOut, 2).Value = 0 wsDst.Cells(rowOut, 3).Value = 0 End If rowOut = rowOut + 1 Next i wsDst.Columns("A:C").AutoFit MsgBox "年度集計が完了しました。", vbInformationEnd Sub実行結果― ― ― ― ― ― ― ― ― ― → Excel VBA基礎入門もくじ へ戻る関連記事『VBA 行列の挿入』行の挿入構文Rows(行番号).Insert 1行を挿入するSub test1() ’ 3行目に1行を挿入する Rows(3).Insert…ameblo.jp『VBA シート追加・削除』シートの追加構文Worksheets.Add(Before, After, Count, Type)引数なにも指定しない場合、アクティブシートの前に追加…ameblo.jp『VBA シート移動・コピー』シートの移動構文Worksheets.Move(Before, After)Sub test1() ’Sheet2をSheet3の後ろ…ameblo.jp『VBA セル値によって色を付ける』セル値によって色を付けるSub test() ’ 条件付き書式設定でセル値によって色を付ける (110％以上水色塗りにする With R…ameblo.jp
