はじめに
「毎月、数十個のアンケートファイルを手作業で集計している」という業務担当者からのご相談は非常に多いです。
本記事では、フォルダ内に散在する複数のExcelファイルをボタンひとつで自動集計するVBAの実装方法を解説します。実際に弊社が開発・納品したシステムをベースにした実践的な内容です。
解決する課題
- フォルダ内に30〜50個のアンケートExcelファイルがある
- 毎月、各ファイルを手作業で開いてデータをコピーしている
- 集計シートへの転記ミスが発生する
- 作業に毎月まる1日以上かかっている
完成イメージ
【フォルダ構成】
C:\anketo\
├── anketo_001.xlsx
├── anketo_002.xlsx
├── anketo_003.xlsx
│ ...
└── anketo_050.xlsx
【集計ファイル】
集計マスター.xlsm ← このファイルにVBAを実装
├── Sheet1（集計結果シート）
└── Module1（VBAコード）
ボタンをクリックすると、指定フォルダ内の全Excelファイルを自動で読み込み、集計シートに転記します。
実装コード
基本構造：フォルダ内ファイルの一括読み込み
Sub 一括集計()
Dim folderPath As String
Dim fileName As String
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Dim lastRow As Long
Dim dstRow As Long
' 集計先シートを指定
Set wsDst = ThisWorkbook.Sheets("集計結果")
' 集計先をクリア（ヘッダー行は残す）
wsDst.Rows("2:" & wsDst.Rows.Count).ClearContents
' 集計先の書き込み開始行
dstRow = 2
' 対象フォルダのパスを指定
folderPath = "C:\anketo\"
' フォルダ内の最初のxlsxファイルを取得
fileName = Dir(folderPath & "*.xlsx")
' ファイルがなくなるまでループ
Do While fileName <> ""
' ファイルを画面更新なしで開く（高速化）
Application.ScreenUpdating = False
Set wbSrc = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
Set wsSrc = wbSrc.Sheets(1)
' データの最終行を取得
lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row
' 2行目以降（ヘッダーを除く）のデータをコピー
If lastRow >= 2 Then
wsSrc.Range("A2:E" & lastRow).Copy _
Destination:=wsDst.Cells(dstRow, 1)
dstRow = dstRow + (lastRow - 1)
End If
' ファイルを閉じる（保存しない）
wbSrc.Close SaveChanges:=False
' 次のファイルへ
fileName = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "集計完了しました。" & Chr(13) & _
"集計件数：" & (dstRow - 2) & "件", vbInformation
End Sub
応用①：クロス集計の自動生成
集計後にPivotTableを自動生成するコードです。
Sub クロス集計作成()
Dim wsDst As Worksheet
Dim wsPivot As Worksheet
Dim pc As PivotCache
Dim pt As PivotTable
Dim pf As PivotField
Dim lastRow As Long
Dim lastCol As Long
Dim dataRange As Range
Set wsDst = ThisWorkbook.Sheets("集計結果")
' データ範囲を取得
lastRow = wsDst.Cells(wsDst.Rows.Count, 1).End(xlUp).Row
lastCol = wsDst.Cells(1, wsDst.Columns.Count).End(xlToLeft).Column
' データが2行以上ない場合は終了
If lastRow < 2 Then
MsgBox "集計データがありません。先に一括集計を実行してください。", vbExclamation
Exit Sub
End If
Set dataRange = wsDst.Range(wsDst.Cells(1, 1), wsDst.Cells(lastRow, lastCol))
' ピボットシートが既にあれば削除して再作成
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Sheets("クロス集計").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set wsPivot = ThisWorkbook.Sheets.Add(After:=wsDst)
wsPivot.Name = "クロス集計"
' ピボットキャッシュを作成
Set pc = ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=dataRange)
' ピボットテーブルを作成
Set pt = pc.CreatePivotTable( _
TableDestination:=wsPivot.Cells(3, 1), _
TableName:="クロス集計表")
' 行・列・値フィールドを設定
With pt
.PivotFields("部門").Orientation = xlRowField
.PivotFields("年代").Orientation = xlColumnField
' AddDataFieldで追加・関数・名前を一括設定（名前変化によるエラーを防ぐ）
Set pf = .AddDataField( _
.PivotFields("Q3_総合評価"), "平均_総合評価", xlAverage)
pf.NumberFormat = "0.0"
End With
' タイトルを追加
wsPivot.Cells(1, 1).Value = "部門×年代 クロス集計（Q3_総合評価 平均）"
wsPivot.Cells(1, 1).Font.Bold = True
MsgBox "クロス集計を作成しました。", vbInformation
End Sub
応用②：条件による自動色分け
集計結果のセルを値に応じて自動で色分けします。
Sub 自動色分け()
Dim wsDst As Worksheet
Dim lastRow As Long
Dim i As Long
Dim score As Double
Dim targetCol As Integer
Set wsDst = ThisWorkbook.Sheets("集計結果")
' 色分け対象の列番号（例：E列 = 5）
targetCol = 5
lastRow = wsDst.Cells(wsDst.Rows.Count, targetCol).End(xlUp).Row
For i = 2 To lastRow
' 空白セルはスキップ
If wsDst.Cells(i, targetCol).Value = "" Then GoTo Continue
score = CDbl(wsDst.Cells(i, targetCol).Value)
Select Case True
Case score >= 80 ' 80以上：緑
wsDst.Cells(i, targetCol).Interior.Color = RGB(144, 238, 144)
Case score >= 60 ' 60〜79：黄
wsDst.Cells(i, targetCol).Interior.Color = RGB(255, 255, 153)
Case Else ' 59以下：赤
wsDst.Cells(i, targetCol).Interior.Color = RGB(255, 153, 153)
End Select
Continue:
Next i
MsgBox "色分けが完了しました。", vbInformation
End Sub
ボタンへの割り当て
上記3つのマクロを順番に実行するメインマクロを作成し、シート上のボタンに割り当てます。
Sub メイン処理()
' 処理開始確認
If MsgBox("集計処理を開始します。よろしいですか？", _
vbYesNo + vbQuestion, "確認") = vbNo Then Exit Sub
' 1. 一括集計
Call 一括集計
' 2. クロス集計
Call クロス集計作成
' 3. 色分け
Call 自動色分け
MsgBox "すべての処理が完了しました。", vbInformation, "完了"
End Sub
実装時のポイント
1. 高速化のための設定
大量ファイルを処理する場合、以下の設定をメイン処理の前後に入れると処理速度が大幅に改善します。
' 処理前（高速化ON）
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
' 処理後（高速化OFF・元に戻す）
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
2. エラーハンドリング
ファイルが壊れていたり、想定外のフォーマットだったりした場合に備えてエラーハンドリングを追加します。
On Error GoTo ErrorHandler
' ～処理～
Exit Sub
ErrorHandler:
' エラー発生時はファイルを閉じて次へ進む
If Not wbSrc Is Nothing Then
wbSrc.Close SaveChanges:=False
End If
MsgBox "エラーが発生しました。" & Chr(13) & _
"ファイル名：" & fileName & Chr(13) & _
"エラー内容：" & Err.Description, vbExclamation
Resume Next
3. フォルダ選択ダイアログの実装
フォルダパスをコードに直書きせず、実行時に選択できるようにするとより使いやすくなります。
' フォルダ選択ダイアログ
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "集計対象フォルダを選択してください"
If fd.Show = True Then
folderPath = fd.SelectedItems(1) & "\"
Else
MsgBox "フォルダが選択されませんでした。", vbExclamation
Exit Sub
End If
実際の導入効果
今回ご紹介したコードをベースに開発したシステムの導入事例です。
| 項目 | 導入前 | 導入後 |
|---|---|---|
| 集計作業時間 | 約8時間／月 | 約10分／月 |
| 転記ミス | 月2〜3件 | ゼロ |
| 集計ファイル数 | 30〜50件 | 変わらず |
| 開発・納品期間 | ー | 約1ヶ月 |
| 開発費用 | ー | 10万円以下 |
まとめ
今回紹介したVBAの主なポイントは以下の通りです。
-
Dir()関数でフォルダ内ファイルをループ処理 -
ScreenUpdating = Falseで高速化 - PivotCacheでクロス集計を自動生成
- Select Caseで条件色分けを自動化
- FileDialogでフォルダ選択をUI化
「繰り返しの手作業」はVBAで自動化できるケースがほとんどです。ぜひ参考にしてみてください。
弊社について
株式会社エム・システムは岩手県盛岡市を開発拠点とするニアショア開発会社で、Excel/VBA開発実績100社以上・リピート率90%・本番稼働まで品質保証する会社です。
「自動化できるか試してみたい」「費用感を知りたい」という段階からご相談いただけます。
お見積りは無償です。