目次
▼この記事の目的
- 同じ形式のExcelファイルが複数あるフォルダ内を巡回し、
- 各ファイルの「特定セル」の値(例:B2, D5など)を取り出し、
- ひとつのExcelファイルにリスト形式でまとめる
▼よくある業務シーン
- 拠点・店舗・部門ごとの報告Excelファイルから「数値」や「担当者名」を集計
- 日次・週次で提出される同形式の帳票の情報を自動で統合
- ファイルを開いて確認する作業を 自動化したい!
▼処理の流れ
- 対象フォルダを選択
- 中の
.xlsx
ファイルを1つずつ開く - 特定のセル(例:B2, D5)から値を取得
- 元ファイル名+取得値を一覧に記録
▼完成イメージ(集約結果)
ファイル名 | 担当者(B2) | 金額(D5) |
---|---|---|
店舗A.xlsx | 田中 | 120000 |
店舗B.xlsx | 佐藤 | 98000 |
▼サンプルコード:特定セルを集約するマクロ
Sub 集約処理_フォルダ内Excelファイル() Dim fso As Object Dim folderPath As String Dim file As Object Dim targetFolder As Object Dim wb As Workbook Dim i As Long ' フォルダ選択 With Application.FileDialog(msoFileDialogFolderPicker) .Title = "対象フォルダを選択してください" If .Show <> -1 Then Exit Sub folderPath = .SelectedItems(1) & "\" End With ' ファイルシステムオブジェクト Set fso = CreateObject("Scripting.FileSystemObject") Set targetFolder = fso.GetFolder(folderPath) ' 結果出力用のシート準備 Sheets.Add(After:=Sheets(Sheets.Count)).Name = "集約結果" With Sheets("集約結果") .Range("A1:C1").Value = Array("ファイル名", "担当者(B2)", "金額(D5)") End With i = 2 ' フォルダ内のxlsxファイルをループ For Each file In targetFolder.Files If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Then Set wb = Workbooks.Open(file.Path, ReadOnly:=True) On Error Resume Next ' 万一のエラー対応(シート名違いやセル参照ミス) With Sheets("Sheet1") ' 対象シート名に合わせて変更 Sheets("集約結果").Cells(i, 1).Value = file.Name Sheets("集約結果").Cells(i, 2).Value = .Range("B2").Value Sheets("集約結果").Cells(i, 3).Value = .Range("D5").Value End With On Error GoTo 0 wb.Close SaveChanges:=False i = i + 1 End If Next file MsgBox "集約が完了しました!", vbInformation End Sub
▼カスタマイズポイント
要素 | 内容 |
---|---|
.Range("B2"), "D5" | 取得したいセルを任意に追加・変更可能 |
Sheets("Sheet1") | 対象シートが複数ある場合は柔軟に変更可 |
拡張子:xlsx | .xlsm や.xls も対象にしたい場合は拡張 |
フォルダ選択ダイアログ | 自動化したい場合はフォルダパスを直接指定可能 |
▼応用展開アイデア
- ファイル内の「最終更新者」や「保存日」を取得し一緒に記録
- シートが存在しない or セルが空欄のときの警告メッセージ表示
- 月次フォルダ構成に対応した集約(サブフォルダ含む)
▼まとめ
このようにVBAを活用すれば:
- 毎月複数ファイルを手作業で開いて集計する作業を1クリックに短縮
- エラーを防ぎ、正確かつ迅速に情報を集約可能
- 特定セルだけでなく、表全体を範囲指定で集計することも可能
コメント