複数のアンケート形式の表や任意形式の帳票タイプの表を回収した後に、1枚のExcelシート上へレコード形式に集約するサンプルコードです。
集計業務の1つに、各個人や各グループから集めたヒアリングシートなどを、1枚のExcelシートに集約データとしてまとめることがあります。
例えば、Excelで作成したアンケート形式のテンプレートを配布し、その回答を取りまとめて集計したり、各部署から集めた回答データを1つのデータに集約するとかです。
本記事では、そのようなケースを想定した簡単なサンプルシートを使い、1つの集約シートへまとめるVBAコードのサンプルをご紹介します。
まずは本記事でご紹介するサンプルファイルの内容と、実行ビフォアアフターが分かる1分動画（音声無し）をご確認ください。
目次
VBAで複数の帳票式回答シートを、1枚のシートに集計させるサンプルファイル
では本記事で取り扱うサンプルファイルになります。
今回のサンプルファイルは取りまとめ用シート「Data」と、各仕入担当からの回答シート7枚から構成されています。図には「井田」の回答例が記載されていますが、各自担当する商品に関する情報が一覧で記載されています。
複数の回答用シートから取りまとめシートに集計させる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 | Sub 帳票形式回答を集約する() Dim wstData As Worksheet '「Data」用オブジェクト変数 Dim wstAnsw As Worksheet '各回答用オブジェクト変数 Dim lngWRow As Long '「Data」への書込行 Dim lngRRow As Long '各回答リストアップ部読込行 Dim r As Long Set wstData = Worksheets("Data") '「Data」シート初期化 With wstData .Rows("2:" & .Rows.Count).ClearContents End With lngWRow = 2 '初期化に伴い書込行も2へリセット 'すべてのワークシートを繰り返し処理 For Each wstAnsw In Worksheets With wstAnsw If .Name <> "Data" Then 'シート名が「Data」を除く場合 For r = 4 To 8 '回答シートの4行目から8行目までのレコードを読み取る処理 If .Cells(r, 5) <> "" Then '「商品名」に記載がある場合 wstData.Cells(lngWRow, 1) = .Cells(r, 5) '商品名転記 wstData.Cells(lngWRow, 2) = .Cells(r, 6) '在庫転記 wstData.Cells(lngWRow, 3) = .Cells(r, 7) '原価転記 wstData.Cells(lngWRow, 4) = .Cells(r, 8) '棚卸資産転記 wstData.Cells(lngWRow, 5) = .Cells(3, 3) '仕入担当転記 wstData.Cells(lngWRow, 6) = .Cells(r, 9) '仕入先転記 wstData.Cells(lngWRow, 7) = .Cells(r, 10) '価格更新日転記 lngWRow = lngWRow + 1 '書込み行を次の行へ進める ElseIf .Cells(r, 5) = "" Then 'シート名が空欄の場合 Exit For '読み取りを終了 End If Next End If End With Next End Sub |
書き写しましたらさっそくVBAを実行してみてください。VBA実行後の「Data」シートは以下の通りになるはずです。
取りまとめシートへ集約させるVBAコードのアルゴリズム
続きましてVBAコードのアルゴリズムにうつりましょう。
3行目： Dim wstAnsw As Worksheet
7枚の回答シート用に使うオブジェクト変数「wstAnsw」を宣言しています。回答シートは7枚ありますが、For Each文で1枚づつ集計しますので、 オブジェクト変数は処理する1枚のシート分を宣言すればOKです。
6行目： Dim lngRRow As Long
回答シート側でデータを読み取る行番号を保持する変数を宣言します。「lngRRow」の変数名は、「Reading Row」からつけました。
17行目： lngWRow = 2
「Data」シート側に、読み取った回答シートのデータを書き込むのですが、その「Data」シートの書込行番号を保持する変数「lngWRow」を、書込み開始行に初期化しています。
20～42行目： For Each wstAnsw In Worksheets ～ Next
7枚の回答用シートを1枚ずつ繰り返し集計するVBAコードです。「In Worksheets」は、「ファイルの中のすべてのワークシートの中から」的な意味合いになり、その中から1枚ずつワークシートを取り出して実行することになります。
22～40行目： If .Name <> "Data" Then ～ End IF
For Each文の中で繰り返し実行されるIf文です。ここでは、For Each文の繰り返し実行対象としているすべてのワークシートから、ワークシート名（「.Name」）が「Data」ではない、すなわち回答シートだけを抽出しています。
23～39行目： For r = 4 To 8 ～ Next
各シートに対し実行される繰り返し処理範囲になります。それでは、このFor文の中で実行される処理について、次の図でお話ししますね。
まず「For r=4 to 8」ですが、回答シートのExcel行番号、4から8に対応させています。図の回答シートExcel行番号4から8を赤枠で囲んでおりますが、これらは商品一覧の先頭データから最終データが書かれている行番号に相当します。
これら1行1行を繰り返す処理の中で、.Cells(r, 5)が空欄かどうかVBAコード24行目のIf文でチェックしています。そして、このIf文が真（.Cells(r, 5)が空欄じゃない）の場合に、Then以降のデータ転記が実行されます。
一方で、.Cells(r, 5)が空欄の場合、VBAコード36行目のElseIf .Cells(r, 5)="" Thenの条件式が真となり、次の実行文「Exit For」で読み取り処理を終了しています。
では、はじめのIf文の条件式が真であった場合、すなわち回答シート側のデータがある場合の具体的な処理内容について次の図でお話ししますね。
VBAコード25～28行目および32, 33行目で、回答シートの6個の項目を、取りまとめシート「Data」の書込み行番号（「lngWRow」）の対応する列へ転記しています。
30行目は残りの「仕入担当」を、回答シートの緑色の枠を示したセル(.Cells(3, 3))から読み取り、取りまとめシート「Data」へ転記しています。
まとめ
集計業務ではよくある複数シートを、1つの取りまとめシートに集約させるVBAサンプルコードについてお話ししました。今回ご紹介したスキルを応用することで、アンケートの回答シートを1つのシートに集計して、アンケート集計結果にまとめることができます。
集計の実務では、各部署に対してヒアリングを行い、その結果を合算集計して分析や報告をするのにも応用出来ます。ぜひここで紹介した考え方をマスターして、実務で活用してくださいね。