6記事に渡って連載をしていましたが最後になります。最後は月ごと、カテゴリごとの収入と支出を合計して表示する機能となります。
これは家計簿としては必須の機能になりますが、最後にしたのはVBAで集計するのは結構面倒で複雑になりがちだからです。
ピポットテーブルとかを使うと楽なので、これだけピポットテーブルでやろうかと思いましたが、VBAで頑張って書いてみることにしました。
※Excel家計簿を作成した方法についての記事の6つ目になります。その他の記事は以下にまとめています。
この記事で実装する集計機能
この記事で作るのは、下記のように月ごとにどれだけ使っているかを確認することが出来る集計表になります。

今回の家計簿では、カテゴリを2段階で設定できるようにしています。
2段階目のカテゴリごとの集計結果を出しつつ、1段階目のカテゴリの合計も表示できるような機能にしました。
上記画像では、見切れていて見えませんが、同様に収入も一覧で出力できるようにします。
月別詳細シートを作成する
今回作成する集計表を出力するシートは「月別詳細」という名前にしました。早速ワークシートを作成します。

次にVBAから出力しない最低限のレイアウトを記載していきます。
今回でいうと表のヘッダーのうち月替記載されない部分は固定で決まるので、そこは予め作成しておくことにします。

A1に大きい文字で「支出」と記載して、B2~D2にカテゴリ列、カテゴリ2列、予算列のヘッダーの文字を記載しました。
支出の表の下に収入表を作る想定ですが、「収入」という文字は、どこの行から始まるかわからないので、VBAで作成することにします。
またレイアウト(色や罫線)は、以前の記事と同様にVBAでテーブルのレイアウトを設定することにします。
定数定義に月別詳細の設定値を追加する
前回までの記事で作成していた定数定義のモジュールに、月別詳細シートの情報を追記します。
最終的には以下のようなコードとなりました。
'ワークシート名
Public Const SH_NAME_TEMPLATE = "template"
Public Const SH_NAME_SUMMARY = "サマリー"
Public Const SH_NAME_TUKIBETU = "月別詳細"
'カテゴリシートの列定義
Public Enum shCateColumns
SHUBETU = 1
CATEGO
CATEGO2
YOSAN
End Enum
'カテゴリシートの行定義
Public Enum shCateRows
START_ROW = 2 '表データの開始行
End Enum
'サマリーシートの列定義
Public Enum shSummaryColumns
KOZA = 1
ZANDAKA = 2
NENGETSU = 4
SHUNYU = 5
SHISHUTU = 6
ZANDAKA2 = 7
End Enum
'サマリーシートの行定義
Public Enum shSummaryRows
START_ROW = 4 '表データの開始行
End Enum
'月別詳細シートの列定義
Public Enum shTukibetuColumns
SHUBETU = 1
CATEGO
CATEGO2
YOSAN
JISSEKI_START
End Enum
'月別詳細シートの行定義
Public Enum shTukibetuRows
NENGETU_ROW = 2 'ヘッダーの行
START_ROW 'データの開始行
End Enum
'口座のシートの列定義
Public Enum shKozaColumns
HIDUKE = 1
SHUBETU
CATEGO
CATEGO2
KINGAKU
MEMO
End Enum
'口座のシートの行定義
Public Enum shKozaRows
START_ROW = 4 '表データの開始行
End Enum
'口座シート種別列の設定値
Public Const SHUBETU_SHOKI = "初期残高"
Public Const SHUBETU_SHISHUTU = "支払い"
Public Const SHUBETU_SHUNYU = "収入"
Public Const SHUBETU_SHUKIN = "出金"
Public Const SHUBETU_NYUKIN = "入金"
'テーブルとして書式設定のテーブル名
Public Const LAYOUT_SUMMARY = "サマリーテーブル"
Public Const LAYOUT_ZANDAKA = "残高"
Public Const LAYOUT_TUKIBETSU_SHUNYU = "月別収入"
Public Const LAYOUT_TUKIBETSU_SHISHUTU = "月別支出"
'テーブルレイアウト名
Public Const TABLE_STYLE = "TableStyleMedium9"
今回は、支出の表と収入の表の両方に「テーブルとして書式設定」をするので、テーブル用の定数として「LAYOUT_TUKIBETSU_SHUNYU」と「LAYOUT_TUKIBETSU_SHISHUTU」の2つを用意しています。
月別、カテゴリ別に収入と支出を保持できるクラスを作成する
各月、各カテゴリごとに収入と支出を変数に保持していく必要があります。
前回の記事と同様に、「年月がキー、収入と支出を保持できるオブジェクトが値」の連想配列(Scripting.Dictionary)を作成していきます。
ただ今回は年月ごとに分けた後、更にカテゴリごとに分かれるのでカテゴリー用のクラスも作成し、これを年月のクラスが複数保持できるようにします。
また、カテゴリーは2段階あるのでカテゴリー用のクラスは再帰呼び出しで自分のクラスも持てるようにします。
言葉だとすごいわかりにくいので、実際に作成したコードを貼ってみます。
↓カテゴリー用のクラス
Private strCategory_ As String
Private dicSubCategory_ As Object
Private strShubetu_ As String
Private lngJisseki_ As Long
Private lngYosan_ As Long
Private Sub Class_Initialize()
lngJisseki_ = 0
lngYosan_ = 0
Set dicSubCategory_ = CreateObject("Scripting.Dictionary")
End Sub
Property Get strCategory() As String
strCategory = strCategory_
End Property
Property Let strCategory(strCategory As String)
strCategory_ = strCategory
End Property
Property Get strShubetu() As String
strShubetu = strShubetu_
End Property
Property Let strShubetu(strShubetu As String)
strShubetu_ = strShubetu
End Property
Property Get lngJisseki() As Long
lngJisseki = lngJisseki_
End Property
Property Let lngJisseki(lngJisseki As Long)
lngJisseki_ = lngJisseki
End Property
Property Get lngYosan() As Long
lngYosan = lngYosan_
End Property
Property Let lngYosan(lngYosan As Long)
lngYosan_ = lngYosan
End Property
Public Sub addYosan(lngYosan As Long)
lngYosan_ = lngYosan_ + lngYosan
End Sub
Public Sub addJisseki(lngJisseki As Long)
lngJisseki_ = lngJisseki_ + lngJisseki
End Sub
Public Sub addSubCategory(subCategory As clsCategory)
dicSubCategory_.Add subCategory.strCategory, subCategory
End Sub
Public Function getSubCategory() As Object
Set getSubCategory = dicSubCategory_
End Function
getterとsetterが多いので長く感じますが、以下の項目を保持できるようになっているだけのクラスです。
strCategoryはカテゴリの名称
strShubetuが「収入」か「支出」かを表す文字列
lngJissekiが家計簿に入力された実績値の合計
lngYosanがカテゴリの予算
を設定するために作成しました。
またdicSubCategoryは自分自身のクラスを連想配列で持てるようにしています。これにカテゴリの2段階目の情報を格納していきます。
月別の集計情報のクラス↓
Private dicCateShunyu_ As Object
Private dicCateShishutu_ As Object
Private Sub Class_Initialize()
Set dicCateShunyu_ = CreateObject("Scripting.Dictionary")
Set dicCateShishutu_ = CreateObject("Scripting.Dictionary")
Call getCategorys(dicCateShunyu_, dicCateShishutu_)
End Sub
Property Get dicCateShunyu() As Object
Set dicCateShunyu = dicCateShunyu_
End Property
Property Let dicCateShunyu(dicCateShunyu As Object)
Set dicCateShunyu_ = dicCateShunyu
End Property
Property Get dicCateShishutu() As Object
Set dicCateShishutu = dicCateShishutu_
End Property
Property Let dicCateShishutu(dicCateShishutu As Object)
Set dicCateShishutu_ = dicCateShishutu
End Property
Private Sub getCategorys(ByRef dicCateShunyu, ByRef dicCateShishutu)
Dim shCategory As Worksheet
Set shCategory = ThisWorkbook.Worksheets("カテゴリ")
Dim lngRow As Long
For lngRow = shCateRows.START_ROW To shCategory.Cells(shCategory.Rows.Count, 1).End(xlUp).Row
Dim dicTarget As Object
If shCategory.Cells(lngRow, shCateColumns.SHUBETU).Value = SHUBETU_SHISHUTU Then
Set dicTarget = dicCateShishutu
Else
Set dicTarget = dicCateShunyu
End If
Dim clsCate As clsCategory
If Not dicTarget.exists(shCategory.Cells(lngRow, shCateColumns.CATEGO).Value) Then
Set clsCate = New clsCategory
clsCate.strShubetu = shCategory.Cells(lngRow, shCateColumns.SHUBETU).Value
clsCate.strCategory = shCategory.Cells(lngRow, shCateColumns.CATEGO).Value
dicTarget.Add shCategory.Cells(lngRow, shCateColumns.CATEGO).Value, clsCate
Else
Set clsCate = dicTarget.Item(shCategory.Cells(lngRow, shCateColumns.CATEGO).Value)
End If
Call clsCate.addYosan(shCategory.Cells(lngRow, shCateColumns.YOSAN).Value)
If Not Trim$(shCategory.Cells(lngRow, shCateColumns.CATEGO2).Value) = "" Then
Dim clsSubCate As clsCategory
Set clsSubCate = New clsCategory
clsSubCate.strShubetu = shCategory.Cells(lngRow, shCateColumns.SHUBETU).Value
clsSubCate.strCategory = shCategory.Cells(lngRow, shCateColumns.CATEGO2).Value
clsSubCate.lngYosan = shCategory.Cells(lngRow, shCateColumns.YOSAN).Value
Call clsCate.addSubCategory(clsSubCate)
End If
Next lngRow
End Sub
月別のクラスの方はフィールドとしては、「dicCateShunyu」と「dicCateShishutu」の2つしかありません。
これは、支出ごとのカテゴリーの連想配列と収入ごとのカテゴリーの連想配列になります。
またgetCategorysという関数は、カテゴリーを記載しているシートから値を取得してカテゴリーの連想配列を作成する関数になります。
VBAで各月の合計支出を計算する
クラスを作成することで、入れ物はできたので、次に入れ物に値を入れる処理をVBAで記載していきます。処理の流れとしては以下になります。
- 月別詳細シートをクリアする
- テーブルの書式を解除
- 年月別の連想配列を作成し、月別の集計情報のクラスを格納
- ワークシートをループさせて年月別の連想配列に収支情報を設定する
- 連想配列をループさせて支出の明細行を作成する
- 連想配列をループさせて収入の明細行を作成する
- テーブルに書式を設定する
入れ物が変わっただけで、処理の流れ的には前回の記事の「VBAで残高の推移を計算する」と同じです。
実際に作成したコードが以下になります。
'月別詳細シート更新のメイン処理
Public Sub btn_tukibetu_calc_click()
'月別詳細シートをクリアする
Dim shTukibetu As Worksheet
Set shTukibetu = ThisWorkbook.Worksheets(SH_NAME_TUKIBETU)
shTukibetu.Rows(shTukibetuRows.START_ROW & ":" & shTukibetu.Rows.Count).Clear
'テーブルの書式を解除
For Each ls In shTukibetu.ListObjects
ls.Unlist
Next ls
'月別詳細シートの表を更新する
Call calcTukibetu(shTukibetu)
'サマリーシートをアクティブにする
shSummary.Activate
End Sub
'月別詳細シートの表を更新する
Private Sub calcTukibetu(shTukibetu As Worksheet)
'現在操作している行
Dim lngRow As Long
lngRow = shTukibetuRows.START_ROW
'現在操作している列
Dim intCol As Integer
intCol = shTukibetuColumns.JISSEKI_START
'年月別の連想配列
Dim dicShushiByNengetu As Object
Set dicShushiByNengetu = CreateObject("Scripting.Dictionary")
'ワークシートをループさせる
For i = 1 To ThisWorkbook.Worksheets.Count
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets(i)
'口座のシートのみを対象とする
If sh.CodeName Like "shKoza*" And sh.Name <> SH_NAME_TEMPLATE Then
'年月別の連想配列に収支情報を設定する
Call getShushiByCategory(dicShushiByNengetu, sh)
End If
Next i
'支出のヘッダー行を入力する
shTukibetu.Cells(shTukibetuRows.NENGETU_ROW, shTukibetuColumns.CATEGO).Value = "カテゴリー"
shTukibetu.Cells(shTukibetuRows.NENGETU_ROW, shTukibetuColumns.CATEGO2).Value = "カテゴリー2"
shTukibetu.Cells(shTukibetuRows.NENGETU_ROW, shTukibetuColumns.YOSAN).Value = "予算"
'年月別の連想配列をループさせる
For Each NenKey In dicShushiByNengetu.keys
lngRow = shTukibetuRows.START_ROW
Dim tukibetu As clsTukibetu
Set tukibetu = dicShushiByNengetu.Item(NenKey)
'日付列を入力する
shTukibetu.Cells(shTukibetuRows.NENGETU_ROW, intCol).Value = NenKey
Dim dicCate As Object
Set dicCate = tukibetu.dicCateShishutu
'行のデータを入力する
Call writeMeisai(lngRow, intCol, dicCate, shTukibetu)
intCol = intCol + 1
Next NenKey
'支出テーブルに書式を設定する
shTukibetu.ListObjects.Add(xlSrcRange, shTukibetu.Range( _
getColumnAddress(shTukibetuColumns.CATEGO) & shTukibetuRows.NENGETU_ROW & ":" & getColumnAddress(intCol - 1) & lngRow - 2), , xlYes).Name = LAYOUT_TUKIBETSU_SHISHUTU
shTukibetu.ListObjects(LAYOUT_TUKIBETSU_SHISHUTU).TableStyle = TABLE_STYLE
'収入表の表名を入力する
shTukibetu.Activate
shTukibetu.Cells(1, 1).Copy
shTukibetu.Cells(lngRow, 1).Select
ActiveSheet.Paste
shTukibetu.Cells(lngRow, 1) = "収入"
'収入のヘッダー行を入力する
lngRow = lngRow + 1
shTukibetu.Cells(lngRow, shTukibetuColumns.CATEGO).Value = "カテゴリー"
shTukibetu.Cells(lngRow, shTukibetuColumns.CATEGO2).Value = "カテゴリー2"
shTukibetu.Cells(lngRow, shTukibetuColumns.YOSAN).Value = "予算"
Dim lngShunyuStartRow As Long
lngRow = lngRow + 1
lngShunyuStartRow = lngRow
intCol = shTukibetuColumns.JISSEKI_START
'年月別の連想配列をループさせる
For Each NenKey In dicShushiByNengetu.keys
lngRow = lngShunyuStartRow
Set tukibetu = dicShushiByNengetu.Item(NenKey)
'日付列を入力する
shTukibetu.Cells(lngRow - 1, intCol).Value = NenKey
Set dicCate = tukibetu.dicCateShunyu
'行のデータを入力する
Call writeMeisai(lngRow, intCol, dicCate, shTukibetu)
intCol = intCol + 1
Next NenKey
'収入テーブルに書式を設定する
shTukibetu.ListObjects.Add(xlSrcRange, shTukibetu.Range( _
getColumnAddress(shTukibetuColumns.CATEGO) & (lngShunyuStartRow - 1) & ":" & getColumnAddress(intCol - 1) & lngRow - 2), , xlYes).Name = LAYOUT_TUKIBETSU_SHUNYU
shTukibetu.ListObjects(LAYOUT_TUKIBETSU_SHUNYU).TableStyle = TABLE_STYLE
End Sub
'行のデータを入力する
Private Sub writeMeisai(ByRef lngRow As Long, ByVal intCol As Integer, ByVal dicCate As Object, ByVal shTukibetu As Worksheet)
'月別の合計金額
Dim lngJissekiGokei As Long
lngJissekiGokei = 0
'予定の合計金額
Dim lngYoteiGokei As Long
lngYoteiGokei = 0
Dim cate As clsCategory
Dim subcate As clsCategory
'カテゴリーをループさせる
For Each catekey In dicCate.keys
Set cate = dicCate.Item(catekey)
'カテゴリー2をループさせる
For Each subkey In cate.getSubCategory.keys
Set subcate = cate.getSubCategory.Item(subkey)
shTukibetu.Cells(lngRow, shTukibetuColumns.CATEGO).Value = catekey
shTukibetu.Cells(lngRow, shTukibetuColumns.CATEGO2).Value = subkey
shTukibetu.Cells(lngRow, intCol).Value = subcate.lngJisseki
shTukibetu.Cells(lngRow, shTukibetuColumns.YOSAN).Value = subcate.lngYosan
lngRow = lngRow + 1
Next subkey
'小計行を入力する
shTukibetu.Cells(lngRow, shTukibetuColumns.CATEGO).Value = catekey
shTukibetu.Cells(lngRow, shTukibetuColumns.CATEGO).Font.Bold = True
shTukibetu.Cells(lngRow, shTukibetuColumns.CATEGO2).Value = "小計"
shTukibetu.Cells(lngRow, shTukibetuColumns.CATEGO2).Font.Bold = True
shTukibetu.Cells(lngRow, shTukibetuColumns.YOSAN).Value = cate.lngYosan
shTukibetu.Cells(lngRow, intCol).Value = cate.lngJisseki
lngJissekiGokei = lngJissekiGokei + cate.lngJisseki
lngYoteiGokei = lngYoteiGokei + cate.lngYosan
lngRow = lngRow + 1
Next catekey
'合計行を入力する
shTukibetu.Cells(lngRow, shTukibetuColumns.CATEGO).Value = "合計"
shTukibetu.Cells(lngRow, shTukibetuColumns.CATEGO).Font.Bold = True
shTukibetu.Cells(lngRow, intCol).Value = lngJissekiGokei
shTukibetu.Cells(lngRow, shTukibetuColumns.YOSAN).Value = lngYoteiGokei
lngRow = lngRow + 2
End Sub
'カテゴリー別の収支情報を取得して年月連想配列にセットする
Private Sub getShushiByCategory(ByRef dicShushiByNengetu As Object, ByVal sh As Worksheet)
Dim lngRow As Long
'ワークシートを使用最終行までループ
For lngRow = shKozaRows.START_ROW To sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
'日付列から年月を取得
Dim strNengetsu As String
strNengetsu = Year(sh.Cells(lngRow, shKozaColumns.HIDUKE).Value) & "年" _
& Month(sh.Cells(lngRow, shKozaColumns.HIDUKE).Value) & "月"
'カテゴリー1列からカテゴリー1を取得
Dim strCate1 As String
strCate1 = sh.Cells(lngRow, shKozaColumns.CATEGO).Value
If sh.Cells(lngRow, shKozaColumns.HIDUKE).Value <> "" And strNengetsu <> "" And strCate1 <> "" Then
Dim tukibetu As clsTukibetu
'年月別の連想配列を取得
If dicShushiByNengetu.exists(strNengetsu) Then
Set tukibetu = dicShushiByNengetu.Item(strNengetsu)
Else
Set tukibetu = New clsTukibetu
dicShushiByNengetu.Add strNengetsu, tukibetu
End If
'種別列の値によって、収入か支出かを判断する
Dim dicCate As Object
Select Case sh.Cells(lngRow, shKozaColumns.SHUBETU).Value
Case SHUBETU_SHUNYU
Set dicCate = tukibetu.dicCateShunyu
Case SHUBETU_SHISHUTU
Set dicCate = tukibetu.dicCateShishutu
Case Else
End Select
'カテゴリ別の収支を取得する
Dim cate As clsCategory
If dicCate.exists(sh.Cells(lngRow, shKozaColumns.CATEGO).Value) Then
Set cate = dicCate.Item(sh.Cells(lngRow, shKozaColumns.CATEGO).Value)
Call cate.addJisseki(sh.Cells(lngRow, shKozaColumns.KINGAKU).Value)
Else
Set cate = New clsCategory
cate.strShubetu = sh.Cells(lngRow, shKozaColumns.SHUBETU).Value
cate.strCategory = sh.Cells(lngRow, shKozaColumns.CATEGO).Value
Call cate.addJisseki(sh.Cells(lngRow, shKozaColumns.KINGAKU).Value)
dicCate.Add cate.strCategory, cate
End If
'カテゴリー2列からカテゴリー2を取得
Dim subcate As Object
Set subcate = cate.getSubCategory
Dim strCate2Name As String
strCate2Name = sh.Cells(lngRow, shKozaColumns.CATEGO2).Value
For Each subkey In subcate.keys
If strCate2Name = subkey Then
Set cate = subcate.Item(strCate2Name)
Call cate.addJisseki(sh.Cells(lngRow, shKozaColumns.KINGAKU).Value)
End If
Next
End If
Next lngRow
End Sub
コメントを残す