今回の記事では、金融資産の合計が月ごとにどのように変化しているかを一覧にする機能について記載してみたいと思います。
家計簿の目的は、「何にどのくらいお金を使ったか」を明確にするためなので必須な機能ではないです。
ただ、個人的に「毎月貯金が増えている」というのが見えるのがモチベーションになると思ったので機能を作成することにしました。
※Excel家計簿を作成した方法についての記事の5つ目になります。その他の記事は以下にまとめています。
この記事で実装する残高の推移表
この記事で作るのは、下記のように月ごとに残高の合計がどのように変化したかという表になります。

また、月ごとの収入と支出の合計も表示できるようになっています。
サマリーシートに残高推移の見出しを追加
前回の記事で作成したサマリーシートに残高の推移表の見出しなどを追加します。具体的には以下のようにセルに値を設定しました。

「残高推移」という表のタイトルを大きいフォントで記載しました。
次に表の見出し行として、D3に「年月」、E3に「収入」、F3に「支出」、G3に「残高」と記載しました。
前回の記事と同様に、表のレイアウトはVBAで設定するのでワークシートに対する設定は以上となります。
定数定義に残高推移表の設定値を追加する
前回の記事で作成したサマリーシートの定数定義に追加を行い、以下のようにします。
'ワークシート名
Public Const SH_NAME_SUMMARY = "サマリー"
'サマリーシートの列定義
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 Const LAYOUT_SUMMARY = "サマリーテーブル"
Public Const LAYOUT_ZANDAKA = "残高"
'テーブルレイアウト名
Public Const TABLE_STYLE = "TableStyleMedium9"
「サマリーシートの列定義」と「テーブルとして書式設定のテーブル名」に値を追加しています。
収入と支出を保持できるクラスを作成する
各月における収入と支出を変数に保持していく必要があります。
それを実現するために「年月がキー、収入と支出を保持できるオブジェクトが値」の連想配列(Scripting.Dictionary)を作成することにしました。
収入と支出を保持できるオブジェクトについてですが、連想配列では構造体を値にすることができないのでクラスを作成することにします。
モジュールを追加する際に、「クラスモジュール」という選択肢があるので、選択します。

クラスに記載したコードが以下のとおりです。
Private lngShunyu_ As Long
Private lngShishutu_ As Long
Private Sub Class_Initialize()
lngShunyu_ = 0
lngShishutu_ = 0
End Sub
Property Get lngShunyu() As Long
lngShunyu = lngShunyu_
End Property
Property Let lngShunyu(lngShunyu As Long)
lngShunyu_ = lngShunyu
End Property
Property Get lngShishutu() As Long
lngShishutu = lngShishutu_
End Property
Property Let lngShishutu(lngShishutu As Long)
lngShishutu_ = lngShishutu
End Property
lngShunyuという変数に収入、lngShishutuという変数に支出を格納する想定です。
色々と関数が書いてありますが、単なるgetter、setterなので単に2つ変数を持っているだけのクラスです。
VBAで残高の推移を計算する
今回の記事のメインになる「VBAで残高の推移を計算する」は以下のような流れになります。
- サマリーシートをクリアする
- テーブルの書式を解除
- 年月別の連想配列を作成する
- ワークシートをループさせて年月別の連想配列に収支情報を設定する
- 連想配列をループさせて明細行を作成する
- テーブルに書式を設定する
'サマリーシートの「残高推移」表を更新する
Public Sub calcSuii()
'共通初期処理
Call appstart
'サマリーシートをクリアする
Dim shSummary As Worksheet
Set shSummary = ThisWorkbook.Worksheets(SH_NAME_SUMMARY)
shSummary.Rows(shSummaryRows.START_ROW & ":" & shSummary.Rows.Count).Clear
'テーブルの書式を解除
For Each ls In shSummary.ListObjects
ls.Unlist
Next ls
'現在操作している行
Dim lngRow As Long
lngRow = shSummaryRows.START_ROW
'残高
Dim lngGokei As Long
lngGokei = 0
'年月別の連想配列
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
'合計金額を加算
lngGokei = lngGokei + getShokiZandaka(sh)
'年月別の連想配列に収支情報を設定する
Call getShushiByNengetu(dicShushiByNengetu, sh)
End If
Next i
'初期残高の行を設定する
shSummary.Cells(lngRow, shSummaryColumns.NENGETSU).Value = "初期残高"
shSummary.Cells(lngRow, shSummaryColumns.SHUNYU).Value = "-"
shSummary.Cells(lngRow, shSummaryColumns.SHISHUTU).Value = "-"
shSummary.Cells(lngRow, shSummaryColumns.ZANDAKA2).Value = lngGokei
'年月別の連想配列をループさせる
For Each Key In dicShushiByNengetu.keys
Dim shushi As clsShushi
Set shushi = dicShushiByNengetu.Item(Key)
If shushi.lngShunyu <> 0 Or shushi.lngShishutu <> 0 Then
lngRow = lngRow + 1
'年月列を設定
shSummary.Cells(lngRow, shSummaryColumns.NENGETSU).Value = Key
'収入列を設定
shSummary.Cells(lngRow, shSummaryColumns.SHUNYU).Value = shushi.lngShunyu
'支出列を設定
shSummary.Cells(lngRow, shSummaryColumns.SHISHUTU).Value = shushi.lngShishutu
'残高列を設定
lngGokei = lngGokei + shushi.lngShunyu - shushi.lngShishutu
shSummary.Cells(lngRow, shSummaryColumns.ZANDAKA2).Value = lngGokei
End If
Next Key
'テーブルに書式を設定する
shSummary.ListObjects.Add(xlSrcRange, Range( _
getColumnAddress(shSummaryColumns.NENGETSU) & shSummaryRows.START_ROW - 1 & ":" & getColumnAddress(shSummaryColumns.ZANDAKA2) & lngRow), , xlYes).Name = LAYOUT_ZANDAKA
shSummary.ListObjects(LAYOUT_ZANDAKA).TableStyle = TABLE_STYLE
'共通終了処理
Call append
End Sub
'口座シートから口座の初期残高を取得する
Private Function getShokiZandaka(sh As Worksheet) As Long
Dim lngRow As Long
'返却値を初期化
getShokiZandaka = 0
'ワークシートを使用最終行までループ
For lngRow = shKozaRows.START_ROW To sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
Select Case sh.Cells(lngRow, shKozaColumns.SHUBETU).Value
'種別列が初期残高、収入、入金の場合
Case SHUBETU_SHOKI
'返却値を加算して処理終了
getShokiZandaka = sh.Cells(lngRow, shKozaColumns.KINGAKU).Value
Exit Function
Case Else
End Select
Next lngRow
End Function
'年月別の連想配列に収支情報を設定する
Private Sub getShushiByNengetu(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) & "月"
If sh.Cells(lngRow, shKozaColumns.HIDUKE).Value <> "" And strNengetsu <> "" Then
Dim shushi As clsShushi
'年月から値を設定する連想配列を取得
If dicShushiByNengetu.exists(strNengetsu) Then
Set shushi = dicShushiByNengetu.Item(strNengetsu)
Else
Set shushi = New clsShushi
dicShushiByNengetu.Add strNengetsu, shushi
End If
Select Case sh.Cells(lngRow, shKozaColumns.SHUBETU).Value
'種別列が収入の場合
Case SHUBETU_SHUNYU
shushi.lngShunyu = shushi.lngShunyu + sh.Cells(lngRow, shKozaColumns.KINGAKU).Value
'種別列が支出の場合
Case SHUBETU_SHISHUTU
shushi.lngShishutu = shushi.lngShishutu + sh.Cells(lngRow, shKozaColumns.KINGAKU).Value
Case Else
End Select
End If
Next lngRow
End Sub
今回、コードがかなり長くなっていますが連想配列を使用していること以外は前回とほぼ同じです。
getShushiByNengetu関数の「年月から値を設定する連想配列を取得」とコメントしている行が鍵になります。
年月の文字列を日付列から取得して、その年月の文字列が
連想配列に存在していない→clsShushiを新規作成して金額を加算
連想配列に存在している→連想配列からclsShushiを取り出して金額を加算
という動きとなります。
その後は、作成した連想配列を「For Each」文で回して、clsShushiに設定した金額をもとに明細行を作成するだけです。
次が最後の記事となりますが、家計簿のメイン機能であるカテゴリ別の集計表を作成します。
次記事
コメントを残す