サイト内検索

VBAで年間予算実績トラッキンググラフと四半期レポートを作成

2019-11-24

年間の予算消費状況を月次でトラッキングできるExcelグラフと、プレゼン用として四半期ごとにまとめた各部門の予実差異レポートを同時に作成するVBAサンプルコードを詳しくご紹介します。

今回は集計対象データから、2種類以上のグラフや表を一度に作成する場合のヒントになるVBAサンプルコードをご紹介します。

サンプルコードを応用すれば、2種類以上のグラフや表でも効率的に作成できますので、実務でも1つの集計対象レコードから、複数の定期レポートを月次や週次で作成する場合にも応用できます。

本記事でご紹介するVBAサンプルコード何ができるかを、下記1分動画（音声無し）でも確認できます。

予算実績トラッキンググラフと四半期レポートのExcelサンプルファイル

本記事で使用するサンプルファイルの中にあるExcelシートをご紹介します。なお、サンプルファイルのダウンロードはシートの紹介の後にあります。

集計データシート

集計対象になる生データを収めたシートです。レコード数は10000レコードあります。項目は「伝票ID」、「会計年」、「会計月」、「部門」、「費目」、「金額」、「予実区分」です。

会計年は2018年です。また予算は1～12月までありますが、実績は意図的に7月までにしています。部門は、人事部、開発部、生産部、品質部、営業部の5部です。また費目の種類は人件費、部門費、設備費です。

グラフ用シート（Chartシート)

年間の累積予算と累積実績をグラフ上で視覚的に確認できるシートです。実績は棒グラフで表示され、内訳を費目別に表示します。また予算は折れ線グラフで1月から12月まで表示されます。

グラフ表示用集計シート

グラフの元になるデータを集計するためのシートです。Excelシート2～4行目に費目ごとの実績値を集計します。また、Excelシート5行目には予算値を集計します。

プレゼン用集計表シート

プレゼン用に見栄えを良くした集計表です。集計対象データを部門別、四半期ごとの予算・実績に分けて集計した上、差異やTotal（合計値）を算出表示します。

ダウンロード用サンプルファイル

本記事で使用するサンプルファイルになります。

BudgetActualGrphReport-1 ダウンロード

予算実績トラッキンググラフと四半期レポートを作成するVBAサンプルコード

VBAサンプルコードです。今回はSub、Functionを使って機能別にVBAコードを整理してみました。コードのアルゴリズムの解説は、後ほどお話ししますが、ダウンロードしたサンプルファイルに、このサンプルコードをコピペして実際に実行結果を確認することもできます。

Option Explicit
    '●モジュール変数
    Dim varGTbl() As Variant: Dim rngGrph As Range      'グラフ用集計表用
    Dim varPTbl() As Variant: Dim rngPrsn As Range      'プレゼン用集計表用
    
Sub Main()
    Call 初期処理       '集計表の集計範囲をリセット
    Call 集計処理       '集計対象データを集計処理
    Call 結果表示       '配列に格納した集計結果をセルに表示
End Sub

Private Sub 初期処理()
    '■集計表データ集計範囲クリア
        'グラフ用集計表
        With Grph
            .Range(.Cells(2, 2), .Cells(5, 13)).ClearContents
        End With
        
        'プレゼン用集計表
        With Prsn
            .Range(.Cells(6, 3), .Cells(11, 17)).ClearContents
        End With
    
    
    '■配列設定
        'グラフ用集計表
        With Grph
            Set rngGrph = .Range(.Cells(1, 1), .Cells(5, 13))
        End With
        
        varGTbl = rngGrph
        
        'プレゼン用集計表
        With Prsn
            Set rngPrsn = .Range(.Cells(1, 1), .Cells(11, 17))
        End With
        
        varPTbl = rngPrsn
End Sub

Private Sub 集計処理()
    Dim lngERow As Long     '集計対象データ最終行番号
    Dim r As Long

    With Data
        lngERow = .Range("A" & .Rows.Count).End(xlUp).Row

        For r = 2 To lngERow
            Call グラフ用集計表(r)
            Call プレゼン用集計表(r)
        Next
    End With
    
    Call 累計処理       'グラフ用集計表予算の累計処理
    Call 合計差異       'プレゼン用集計表の合計と差異の算出
End Sub

Private Sub グラフ用集計表(ByVal r As Long)
    Dim lngWRow As Long     '書込み行用変数
    Dim lngWCol As Long     '書込み列用変数
    
    '書込み行
    If Data.Cells(r, 7) = "実績" Then
        Select Case Data.Cells(r, 5)
            Case "人件費": lngWRow = 2
            Case "設備費": lngWRow = 3
            Case "部門費": lngWRow = 4
        End Select
    Else
        lngWRow = 5
    End If
    
    '書込み列
    lngWCol = Data.Cells(r, 3) + 1
    
    '配列代入
    varGTbl(lngWRow, lngWCol) = varGTbl(lngWRow, lngWCol) + Data.Cells(r, 6)
End Sub

Private Sub プレゼン用集計表(ByVal r As Long)
    Dim lngWRow As Long     '書込み行用変数
    Dim lngWCol As Long     '書込み列用変数
    
    '書込み行
    Select Case Data.Cells(r, 4)
        Case "人事部": lngWRow = 6
        Case "開発部": lngWRow = 7
        Case "生産部": lngWRow = 8
        Case "品質部": lngWRow = 9
        Case "営業部": lngWRow = 10
    End Select
    
    '書込み列
    Select Case Data.Cells(r, 3)
        Case 1, 2, 3:       lngWCol = 3
        Case 4, 5, 6:       lngWCol = 6
        Case 7, 8, 9:       lngWCol = 9
        Case 10, 11, 12:    lngWCol = 12
    End Select
    
    If Data.Cells(r, 7) = "実績" Then lngWCol = lngWCol + 1     '実績の場合は書込み列番号を+1
    
    '■集計結果を配列へ格納
    varPTbl(lngWRow, lngWCol) = varPTbl(lngWRow, lngWCol) + Data.Cells(r, 6) / 1000
    
    '年間Total欄
    If Data.Cells(r, 7) = "予算" Then
        varPTbl(lngWRow, 15) = varPTbl(lngWRow, 15) + Data.Cells(r, 6) / 1000       '年間予算合計処理
    Else
        varPTbl(lngWRow, 16) = varPTbl(lngWRow, 16) + Data.Cells(r, 6) / 1000       '年間実績合計処理
    End If
End Sub

Private Sub 累計処理()
    Dim r As Integer
    Dim c As Integer
    
    For r = 2 To 5
        For c = 3 To 13
            If varGTbl(r, c) <> 0 Then
                varGTbl(r, c) = varGTbl(r, c - 1) + varGTbl(r, c)   'すべての行毎に累計
            End If
        Next
    Next
End Sub

Private Sub 合計差異()
    Dim r As Integer
    Dim c As Integer
    
    '差異計算
    For c = 5 To 17 Step 3
        For r = 6 To 10
            varPTbl(r, c) = varPTbl(r, c - 2) - varPTbl(r, c - 1)   '予算 - 実績
        Next
    Next

    '四半期別合計値計算
    For c = 3 To 17
        For r = 6 To 10
            varPTbl(11, c) = varPTbl(11, c) + varPTbl(r, c)         '全部門合計
        Next
    Next
End Sub

Private Sub 結果表示()
    rngGrph.Value = varGTbl     'グラフ用集計表結果表示
    rngPrsn.Value = varPTbl     'プレゼン用集計結果表示
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

Option Explicit

'●モジュール変数

Dim varGTbl() As Variant: Dim rngGrph As Range 'グラフ用集計表用

Dim varPTbl() As Variant: Dim rngPrsn As Range 'プレゼン用集計表用

Sub Main()

Call 初期処理 '集計表の集計範囲をリセット

Call 集計処理 '集計対象データを集計処理

Call 結果表示 '配列に格納した集計結果をセルに表示

End Sub

Private Sub 初期処理()

'■集計表データ集計範囲クリア

'グラフ用集計表

With Grph

.Range(.Cells(2, 2), .Cells(5, 13)).ClearContents

End With

'プレゼン用集計表

With Prsn

.Range(.Cells(6, 3), .Cells(11, 17)).ClearContents

End With

'■配列設定

'グラフ用集計表

With Grph

Set rngGrph = .Range(.Cells(1, 1), .Cells(5, 13))

End With

varGTbl = rngGrph

'プレゼン用集計表

With Prsn

Set rngPrsn = .Range(.Cells(1, 1), .Cells(11, 17))

End With

varPTbl = rngPrsn

End Sub

Private Sub 集計処理()

Dim lngERow As Long '集計対象データ最終行番号

Dim r As Long

With Data

lngERow = .Range("A" & .Rows.Count).End(xlUp).Row

For r = 2 To lngERow

Call グラフ用集計表(r)

Call プレゼン用集計表(r)

End With

Call 累計処理 'グラフ用集計表予算の累計処理

Call 合計差異 'プレゼン用集計表の合計と差異の算出

End Sub

Private Sub グラフ用集計表(ByVal r As Long)

Dim lngWRow As Long '書込み行用変数

Dim lngWCol As Long '書込み列用変数

'書込み行

If Data.Cells(r, 7) = "実績" Then

Select Case Data.Cells(r, 5)

Case "人件費": lngWRow = 2

Case "設備費": lngWRow = 3

Case "部門費": lngWRow = 4

End Select

Else

lngWRow = 5

End If

'書込み列

lngWCol = Data.Cells(r, 3) + 1

'配列代入

varGTbl(lngWRow, lngWCol) = varGTbl(lngWRow, lngWCol) + Data.Cells(r, 6)

End Sub

Private Sub プレゼン用集計表(ByVal r As Long)

Dim lngWRow As Long '書込み行用変数

Dim lngWCol As Long '書込み列用変数

'書込み行

Select Case Data.Cells(r, 4)

Case "人事部": lngWRow = 6

Case "開発部": lngWRow = 7

Case "生産部": lngWRow = 8

Case "品質部": lngWRow = 9

Case "営業部": lngWRow = 10

End Select

'書込み列

Select Case Data.Cells(r, 3)

Case 1, 2, 3: lngWCol = 3

Case 4, 5, 6: lngWCol = 6

Case 7, 8, 9: lngWCol = 9

Case 10, 11, 12: lngWCol = 12

End Select

If Data.Cells(r, 7) = "実績" Then lngWCol = lngWCol + 1 '実績の場合は書込み列番号を+1

'■集計結果を配列へ格納

varPTbl(lngWRow, lngWCol) = varPTbl(lngWRow, lngWCol) + Data.Cells(r, 6) / 1000

'年間Total欄

If Data.Cells(r, 7) = "予算" Then

varPTbl(lngWRow, 15) = varPTbl(lngWRow, 15) + Data.Cells(r, 6) / 1000 '年間予算合計処理

Else

varPTbl(lngWRow, 16) = varPTbl(lngWRow, 16) + Data.Cells(r, 6) / 1000 '年間実績合計処理

End If

End Sub

Private Sub 累計処理()

Dim r As Integer

Dim c As Integer

For r = 2 To 5

For c = 3 To 13

If varGTbl(r, c) <> 0 Then

varGTbl(r, c) = varGTbl(r, c - 1) + varGTbl(r, c) 'すべての行毎に累計

End If

End Sub

Private Sub 合計差異()

Dim r As Integer

Dim c As Integer

'差異計算

For c = 5 To 17 Step 3

For r = 6 To 10

varPTbl(r, c) = varPTbl(r, c - 2) - varPTbl(r, c - 1) '予算 - 実績

'四半期別合計値計算

For c = 3 To 17

For r = 6 To 10

varPTbl(11, c) = varPTbl(11, c) + varPTbl(r, c) '全部門合計

End Sub

Private Sub 結果表示()

rngGrph.Value = varGTbl 'グラフ用集計表結果表示

rngPrsn.Value = varPTbl 'プレゼン用集計結果表示

End Sub

VBAサンプルコード実行結果

サンプルファイルとサンプルコードによる実行結果です。

トラッキンググラフ

1つ目のトラッキンググラフです。下図のような実行結果になります。予算（青ライン）、実績（積上げ棒グラフ）とも累積値を示していますので、各月ごとの予実比較が一目で確認できます。また年間の予算に対する消費状況も把握しやすいですよね。

グラフ用集計シート

グラフ作成の元データとなるグラフ表示用集計シートの結果です。この後にご紹介するプレゼン用ではないため、グラフ作成に都合のよい表形式にしています。

プレゼン用集計表

プレゼン用に体裁を整えた集計表になります（下図）。Q1～Q4までの四半期ごとの予実と差異を部門ごとに集計しています。また年間Total欄や社全体のTotal欄も設けています。

グラフ用とプレゼン用2つの表を集計させるVBAのアルゴリズム

この項では、サンプルコードについて詳しく解説しております。また既出のアルゴリズムについては、ご案内している過去記事を参照ください。

サンプルコード内でのワークシートの取り扱いについて

今回のサンプルコードでは、3枚のワークシート名をオブジェクト名で扱います（下図）。

このワークシートのオブジェクト名の取り扱い方法は、「VBAコードにオブジェクト名を使う複数ワークシート管理法」の記事の中で詳しく解説しています。

モジュール変数

3行目： Dim varGTbl() As Variant: Dim rngGrph As Range
4行目： Dim varPTbl() As Variant: Dim rngPrsn As Range
今回はモジュール変数を4つ設定しました。VBAコード3行目は、グラフ用集計シートの集計用としての配列変数とRangeオブジェクトを、VBAコード4行目はプレゼン用集計シートの集計用としての配列変数とRangeオブジェクトをそれぞれ宣言しています。

今回は10000レコードありますので、集計処理は配列を使い処理を高速化します。

Sub Main

7行目： Call 初期処理
8行目： Call 集計処理
9行目： Call 結果表示
VBA実行をスタートさせるメインのサブルーチンです。たった3行しかありませんが、これは処理内容と処理の流れが把握しやすいようにするためです。

今回のような小規模な集計システムでは、ここまでする必要はないかもしれませんが、中規模以上のコード行数が数百から数千行にも及ぶものについては、Sub, Functionを使った処理の構造化を取り入れたプログラミングをお勧めします。

初期処理

このサブルーチンでは、集計前に実行する初期処理をまとめていますが、大きく2つのことを処理しています。1つ目は、集計データ範囲のセルをクリアしています（下図赤枠）。2つ目は、集計処理に使う配列の設定をしています（下図青枠）。

集計シート上の集計データ表示範囲をクリア

前半のセルのクリア処理です。今回のサンプルでは、グラフ集計用とプレゼン用の2つの表がありますので、それら2枚のシートの初期化を行います。

下図赤で示したのは、グラフ用集計表のデータ集計範囲に関する処理です。そして、青で示したのはプレゼン用集計表のデータ集計範囲に関する処理です。

配列設定

初期処理の前半部分で、各集計表シートのセルをクリアしましたので、次に集計結果を格納する配列の設定をします。

ポイントは、Excelシートの行列番号と配列の要素番号を合わせるために、配列に格納するセル範囲の起点をA1セルに指定することです。

この手法のバリエーションについては、「VBA集計業務で二次元配列を使い処理を高速化させるサンプル」でも詳しく解説しておりますので、ここでは簡単に触れておきます。

下図赤で示したのは、グラフ用集計表に関する処理で、赤枠で示した範囲(rngGrph)をまるごと配列varGTblに格納(VBAコード31行目)しています。

また、下図青で示したのは、プレゼン用集計表に関する処理で、青枠で示した範囲(rngPrsn)をまるごと配列varPTblに格納(VBAコード38行目)しています。

集計処理

集計対象レコードをFor文で繰り返し処理しながら、配列varGTblと配列varPTblに集計結果を格納する処理（下図太字部）になります。Call文でサブルーチンを呼び出すときに、引数として処理対象行番号の変数rを渡しています。

これら2つのCall文は、For ～ Next文中で使われていますので、それぞれレコード数分の10000回実行されることになります。

そのくり返し処理の後は、varGTblに対してはグラフを累積表示させるための累計処理(下図青字）を、varPTblに対しては合計欄と差異欄の集計処理（下図緑字）をします。

グラフ用集計表

集計対象レコードから、グラフ用集計表へ集計するための処理になります。集計結果は、最終的にVBAコード77行目で一旦varGTblに格納されます。

初めから見ていきますね。

VBAコード58行目で、処理対象行rを引数として受け取ることで、処理中のレコードが特定されます。その後、書込み行の処理のところ（赤字部）では、はじめに予実区分を判定(VBAコード63行目)した後に、費目の値に応じた処理をしています。

続くVBA74行目では、対象レコードの月データ値(集計データシート3列目)に+1することで書込み列を算出しています。

プレゼン用集計表

こちらの引数も集計対象レコード行番号を格納した変数rです（VBAコード80行目）。順に書込み行番号（下図赤文字）、書込み列番号（下図青文字）を判定し、最後に結果を配列変数varPTblに格納（下図緑字）しています。

ここから配列変数varPTblへの代入について補足します。

104行目： varPTbl(lngWRow, lngWCol) = varPTbl(lngWRow, lngWCol) + Data.Cells(r, 6) / 1000
算出された書込み行番号(lngWRow)と書込み列番号(lngWCol)を要素番号にもつ配列変数varPTbl(lngWRow, lngWCol)に、集計対象レコードの6列目の金額を1000で割って代入しています。ここで1000で割っている理由は、プレゼン用集計表右上の単位が千円であるためです。

108行目： varPTbl(lngWRow, 15) = varPTbl(lngWRow, 15) + Data.Cells(r, 6) / 1000
110行目： varPTbl(lngWRow, 16) = varPTbl(lngWRow, 16) + Data.Cells(r, 6) / 1000
VBAコード104行目に続き、集計対象レコードの予実区分により、プレゼン用集計表のTotal欄の予算（プレゼン用集計シート15列目）、もしくは実績(プレゼン用集計シート16列目）にも金額/1000を加算しています。

こうすることで、1回の処理で該当する四半期の欄と合計欄の2か所に対して集計をしています。

累計処理

集計処理サブルーチンの繰り返し処理が終わり、グラフ用集計シートに表示するデータは配列変数varGTblに格納されました。あとは、実行結果でもご紹介しました通り、グラフ上の予算と実績を累積表示させるための処理をこのサブルーチンで行います。

累計処理は予算・実績とも必要ですので、下図の通り行方向（赤字）と列方向（青字）に順次繰り返して処理をします。累計値を求める考え方は、当月のデータと前月のデータを一旦足し合わせたものを、再び当月データに代入します。（VBAコード121行目)

ここでポイントとなるのは、累積予算は12月までを必要としますが、累積実績の方は計上されている月までにすることです。この点については、VBAコード120行目で、当月データが0の場合は処理を実施しないというIf文で実現しています。

合計差異

集計処理サブルーチンの最後のサブルーチンになります。こちらはプレゼン用集計表に対する処理になります。

まず、VBAコード131～136行目（下図赤字）で、各四半期と年Total欄（5列）の予算と実績の差異を集計しています。そして、VBAコード138～143行目で列方向のTotal値を集計しています。

以上、集計処理サブルーチンについて解説してきましたが、書込み行や書込み列算出の考え方や、差異、累積、Totalの求め方の詳細については、「VBAで会計データから全社と部門別の月次予実グラフを自動作成」や「VBAで月次予算実績推移の棒グラフを部門別内訳にして作成する」などの過去記事で詳細に解説しておりますので、こちらもご参考にしてみてください。

結果表示

147行目：rngGrph.Value = varGTbl
148行目： rngPrsn.Value = varPTbl
ここまでですべての集計結果が配列変数varGTblとvarPTblに格納されましたので、あとはVBAコード147行目と148行目で、それぞれの集計表への表示をするだけになります。

追加の表やグラフを増やしたい場合は？

本記事の最後に、追加で表やグラフを増やしたい場合、どのようにコードを修正すればよいかについて、今回のサンプルコードを元にお話ししたいと思います。

まず第一に、グラフが増えても、表が増えてもコード側からすれば集計表が増えただけです。よって、グラフとかプレゼン用とか意識せずにコードの追加修正をすればよいことになります。

モジュール変数を追加

まずはモジュール変数として、新たに配列変数とRangeオブジェクトを追加します（下図）。

初期処理サブルーチンに追加修正

初期処理では、2つの処理を実行していましたよね。よって、ここにもそれぞれ追加の処理を記述します。

集計処理サブルーチンに追加修正

集計処理サブルーチンに対しては、まず集計対象レコードを繰り返し処理するFor ～ Next文の中に、追加した集計表に対する処理サブルーチンを引数rを指定して記述します。

そして、図中に示した通り必要に応じて追加の処理サブルーチンも追加します。この必要に応じて追加するサブルーチンですが、文字通り必ずしも必要ではないということになります。

今回のサンプルでは、グラフ用集計シートに対しては累計処理が追加で必要でしたし、プレゼン用集計表では差異や合計欄などの追加処理が必要でしたので、それぞれ「累計処理」や「合計差異」をサブルーチンとして追加しています。

結果表示サブルーチンに追加修正

追加した集計表への集計結果を表示させるための処理記述が必要になります。

まとめ

今回はサブルーチンを使い、ある意味でまとまった処理ごとに整理してみました。このようにすることで、後でグラフが追加されたり、集計表が追加された場合でも、どこを追加すれば分かりやすくなったのではと思います。

また、不要となった処理を削除（あるいはコメントアウト）したり、VBAコードの改修箇所も把握しやすくなったのではと思います。

[スポンサーリンク]

サイト内検索

-別シート, 転記する
-グラフ用集計表, 配列導入コード

: VBAで会計データから全社と部門別の月次予実グラフを自動作成
会社の会計データから、全社グラフと各部門別グラフに分けて、月ごとに予算と実績を比較できる棒グラフをVBAで自動作成します。各棒グラフの内訳には費目を使います。過去記事の「VBAで月次予算実績推移の棒 ...

: VBAで複数シート上のレコードを1つのクロス集計表に集約する
各部署ごとにシート分けされた会計レコードを、直接クロス集計するVBAサンプルコードをご紹介します。各部署ごとのレコードを、一度全社レコードとして1つのシートにまとめる必要がない場合は、コード量が少ない ...

: VBAで生データの複数項目列の削除と並べ替えの一括処理を行う
生データから集計に関係のない複数列を削除すると同時に、列順を任意の順番に並べ替えて別シートに表示するサンプルコードをご紹介します。 Excel集計業務では、基幹システムから得られた生データを集計前に加 ...

: VBAコードで対象レコードとは別シートに集計させる
集計対象レコードのあるシートとは別シートに、クロス集計表を作ります。対象レコードのフィールド（見出し項目）数が多い場合、同一シート上に表を作成するスペースがありませんよね。そういう時は、対象レコードと ...

: VBAで予算内訳を部門、実績内訳を費目にしたグラフを自動作成
会社の経費データから毎月の予算・実績を比較した棒グラフをVBAで自動作成するサンプルコードです。予算と実績の棒グラフ内訳は、予算は部門別に、実績は費目別にしています。例えば、予算内訳は年間を通じて各 ...

: VBAコードで部門別費目別に月ごとの経費をクロス集計する
部門毎に各費目内訳がある2段行見出しのクロス集計表です。会計データから月別の経費実績を集計します。また作成される結果の表は別シートになります。部門別に各月の経費実績表を作ると、さらに各部門を費目別に ...

: VBAで複数シートを参照テーブル経由で1つのシートにまとめる
VBAで複数シート上のレコードを、参照テーブルを介して1つのシートに集計します。今回は集計対象となる複数シートの項目を、集計先のシートの項目に合わせるために、転記の途中で参照テーブルを見にいかせます。 ...

: VBAコードで部門別に各経費費目に分けて集計する
会計データから部門別の経費消費状況を、会計データとは別シート上にクロス集計するサンプルコードです。会社の基幹システムの会計データを使い、各部門が経費をどのくらい消費しているかを表にまとめてチェックす ...

: VBAでプロジェクト進捗管理グラフの週次ステータスを集計する
プロジェクトの進捗状況を報告するための週次棒グラフをVBAで自動集計します。今回のサンプルは、筆者がある企業のコスト削減プロジェクトのレポート作成担当だった際、実際に利用していたプロジェクト進捗管理 ...

: VBAコードで部門別に月ごとの経費を集計するサンプル
会計データから、部門別に月ごとの経費消費実績をクロス集計させます。作成するクロス集計表は、会計データとは別シートに作成されます。基幹システムから得た会計データに対して、会計月ごとに部門別の実績を表に ...

PREV: VBAコードにSub、Functionを導入して可読性・保守性を改善する
NEXT: VBAで電話番号のハイフン削除とメールアドレスを分割取得する