【Excel家計簿(6/6)】月別、カテゴリ別に集計を表示する

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で記載していきます。処理の流れとしては以下になります。

  1. 月別詳細シートをクリアする
  2. テーブルの書式を解除
  3. 年月別の連想配列を作成し、月別の集計情報のクラスを格納
  4. ワークシートをループさせて年月別の連想配列に収支情報を設定する
  5. 連想配列をループさせて支出の明細行を作成する
  6. 連想配列をループさせて収入の明細行を作成する
  7. テーブルに書式を設定する

入れ物が変わっただけで、処理の流れ的には前回の記事の「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


コメントを残す

メールアドレスが公開されることはありません。

日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)