部門毎に各費目内訳がある2段行見出しのクロス集計表です。会計データから月別の経費実績を集計します。また作成される結果の表は別シートになります。
部門別に各月の経費実績表を作ると、さらに各部門を費目別に分けたくなりますよね。ピボットテーブルでいうと、行見出しが2段ある状態です。
今回ご紹介するサンプルコードは、行見出しが部門と費目の2段の場合ですが、応用すれば3段でも4段でも簡単に作ることができます。
まずは本記事でご紹介するサンプルファイルの内容と、実行ビフォアアフターが分かる1分動画（音声無し）をご確認ください。
目次
VBAコードで部門別費目別に月ごとの経費を集計するサンプルファイル
では今回のサンプルファイルのご紹介です。
サンプルファイルのシート構成は、対象データがある「集計データ」シートと、表がある「部門費目別月別クロス集計」シートの2枚です。
表ですが、各部ごとに3つの費目の内訳があるサンプルにしました。ここで、通常であれば各部の小計行も入れるべきところですが、説明を簡単にするために敢えて省略しました。
VBAで各部ごとに費目内訳を集計させるサンプルコード
では今回のVBAサンプルコードです。ぜひまねして書いてみてくださいね。あるいは時間がない場合は、標準モジュールを追加してからコピペして実行してみてください。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | '各部門を費目別に分けて、月ごとの経費に集計 Sub 部門別費目別の月ごとのサンプルコード() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim wstSelf As Worksheet Dim wstData As Worksheet Dim lngWRow As Long Dim lngWCol As Long Dim r As Integer Set wstSelf = Worksheets("部門費目別月別クロス集計") With wstSelf .Range(.Cells(2, 3), .Cells(16, 14)).ClearContents End With Set wstData = Worksheets("集計データ") With wstData For r = 2 To .Range("A" & .Rows.Count).End(xlUp).Row If .Cells(r, 7) = "実績" Then '「部門」による書込み基準行取得 Select Case .Cells(r, 4) Case "人事部": lngWRow = 2 Case "開発部": lngWRow = 5 Case "生産部": lngWRow = 8 Case "品質部": lngWRow = 11 Case "営業部": lngWRow = 14 End Select '費目別による書込み行の決定 Select Case .Cells(r, 5) Case "人件費": lngWRow = lngWRow + 0 Case "部門費": lngWRow = lngWRow + 1 Case "設備費": lngWRow = lngWRow + 2 End Select '書込み列取得 lngWCol = .Cells(r, 3) + 2 '転記 wstSelf.Cells(lngWRow, lngWCol) = wstSelf.Cells(lngWRow, lngWCol) + .Cells(r, 6) End If Next End With Application.Calculation = xlCalculationAutomatic End Sub |
では、書き写しましたらVBAを実行してみてください。実行後は下図の通り、各部各費目別に月ごとの経費実績が表示されるはずです。
VBAコードで部門別費目別に月ごとの経費実績を集計させるアルゴリズム
16～18行目： With wstSelf ～ End With
表範囲を初期化のためにクリアするVBAコードです。
23～47行目：For ～ Next
すべての対象レコードを1つずつ繰り返し処理をします。
24行目： If .Cells(r, 7) = "実績" Then
このVBAコードで対象レコードの7列目「予実区分」が「実績」だけを抽出します。
次は、表への「書込み行」と「書込み列」についてです。ポイントは、「書込み行」と「書込み列」を分けて考えます。
VBAで部門別費目別に書き込む行を決めるアルゴリズム
まずは、「書込み行」を考えてみますね。図を用意しましたので、ご覧ください。
VBAコード 26～39行目までで、表への最終的な書込み行を決めています。まずは、前半の26～32行目で基準行を決めてから、後半の35～39行目でオフセット行数を決めて、前半の基準行に後半のオフセット行を加算することで、最終的な書込み行を決めています。
まずは前半からお話ししますね。前半部分は、図の赤色で示しています。VBAコード26行目で、レコード4列目「部門」により基準行「lngWRow」を決めます。例えば、人事部であれば、lngWRow=2ですので、基準行はサンプルシート2行目になります。
同様に、部門によって決まる基準行は、図のサンプルシート赤枠の行番号になります。
次に後半部分のVBAコード35行目は、Select文の条件にレコード5列目「費目」を判定しています。VBAコード36～38行目は各費目によって、直前で決まったlngWRowにオフセット量を加算しています。
例えば、基準行（赤枠部）がサンプルシート2行目の人事部は、費目が人件費であれば、基準行と同じ行になるのでオフセット量は0と考えます。部門費は+1, 設備費は+2のオフセット量です。
ポイントは、各費目のオフセット量は、部によって決まる基準行（赤枠）に対して、費目ごとに同じオフセット量になります。
VBAで部門別費目別に書き込む列を決めるアルゴリズム
図の赤枠は、サンプルシートの列番号で、書き込み列番号になります。その数字とすぐ下の月（青枠）を比べると、書込み列（赤枠）に対して月（青枠）がどれも2少ないですよね。
言い方を変えると、月の値に2を加えるとサンプルシートの書込み列番号になりますよね。それをVBAコード42行目「lngWCol = .Cells(r, 3) + 2」で表しています。
45行目： wstSelf.Cells(lngWRow, lngWCol) = wstSelf.Cells(lngWRow, lngWCol) + .Cells(r, 6)
サンプルシート上の書込み行番号「lngWRow」と書込み列番号「lngWCol」が決まりましたので、表へ加算しています。なお、ここのアルゴリズムについては、下記でも詳しく解説しております。
まとめ
行見出しが部門別と費目別の2段になった表に、月ごとの経費実績を集計させるVBAサンプルコードを紹介しました。ピボットテーブルでもよく見られるように、行見出しが2段、3段になるような表を、VBAコードで実装したい場合、今回ご紹介した基本的なスキルが役に立ちます。
ポイントは、書込み行を決めるプロセスを、1段目と2段目に分けて考えることが出来るので、例えば3段目、4段目も同様の考え方を用いれば、簡単にVBAコードが書けます。