複数のbookを1つにまとめるマクロを紹介します
ダウンロードファイルもありますので良かったら試してみてください
またマクロコードも紹介しています
使用方法解説動画↓
仕事でデータ解析をするとき、月毎のデータなどを集めて分析することが多いと思います
月毎にファイルが違う場合、一つ一つ開いてデータを集めて1つのシートにまとめる
この作業が時間かかって、めんどくさいんでよね
あとミスも増えます
そこで複数のbookを1つにまとめるマクロを作りました
これにより簡単にデータを集め分析が早くできます
仕事で利用して、1分でも早く退社しましょ！
目指せ！定時あがり！
ダウンロードファイル
ファイルです→複数のbookデータを1つにまとめるマクロ.xlsm
※インターネットからのマクロは、Office では既定でブロックされますので許可する必要があります
詳細はマイクロソフトが公開してますので参考にしてください →詳細ページ
ファイルダウンロードがちょっと怖いという方はコードをコピペして使ってください
ファイルを開くと黄色タスクバーが出てくるので、「編集を有効にする」を押すと
今度は赤色のタスクバーがでできます「詳細を表示」を押してもうまく動かせないので
次の操作をしてください
使いたいファイルの「プロパティ」を開きます
赤枠の中の「許可する（K）」にチェックを入れて「適用」をクリックしてください
すると赤枠がなくなるので使えるようになります
マクロコード
※マクロを入れる場合、EXCELファイルをマクロ形式にしてください
その後、Alt+F11でマクロの画面に移り変わるので、Alt+I+Mを押して
表示した画面にコピペしてください
下の記事にマクロの取り込み方法をまとめたのでよかったら参考にしてください
集計したいデータの格納フォルダ作成 マクロ
Option Explicit
Sub 格納フォルダ作成()
'変数////////////////////////////////////////////////////
Dim FSO As Object 'ファイルシステムオブジェクト用変数
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim wb As Workbook: Set wb = ThisWorkbook 'このbook用変数
'データ格納フォルダー作成/////////////////////////////////////////////////////
If FSO.FolderExists(wb.Path & "￥" & "データ格納フォルダ") = False Then 'データ格納フォルダがないとき
FSO.CreateFolder wb.Path & "￥" & "データ格納フォルダ" 'フォルダを作成
MsgBox "データ格納フォルダを作成しました" & vbCrLf & vbCrLf & "集計したいデータを「データ格納フォルダ」に入れてください"
Else 'データ格納フォルダがあった場合
MsgBox "データ格納フォルダは既に作成されてます"
End If
Set FSO = Nothing
End Sub
集計データの初期化 マクロ
Option Explicit
Sub 集計データ初期化()
'変数////////////////////////////////////////////////////
Dim wb As Workbook: Set wb = ThisWorkbook 'このbook用変数
Dim ws_集計データ As Worksheet: Set ws_集計データ = wb.Sheets("集計データ") '集計データSheet用変数
'初期化////////////////////////////////////////////////
ws_集計データ.Cells.Delete
End Sub
データ集計 マクロ
Option Explicit
Sub データ集計()
'変数////////////////////////////////////////////////////
Dim wb As Workbook: Set wb = ThisWorkbook 'このbook用変数
Dim d_wb As Workbook '集計するデータ用book
Dim ws_集計データ As Worksheet: Set ws_集計データ = wb.Sheets("集計データ") '集計データSheet用変数
Dim ary_d 'データ配列用変数
Dim i, j, c 'カウンター変数
Dim f_path As String: f_path = wb.Path & "￥" & "データ格納フォルダ" 'データ格納フォルダのパス用変数
Dim n_file As String: n_file = Dir(f_path & "￥*")
Dim last_r '最終行用変数
Dim yesnocancel As String 'msgbox用変数
'ファイルを開く→配列に代入→集計データSheetに貼付け→配列初期化////////////////
yesnocancel = MsgBox("すべてのデータの先頭行は入れますか？", vbYesNoCancel) '「はい」先頭行を含めない「いいえ」先頭行を含める「キャンセル」マクロの起動を止める
If yesnocancel = 2 Then
Exit Sub
End If
Do While n_file <> ""
Set d_wb = Workbooks.Open(f_path & "￥" & n_file) 'ファイルを開く
ary_d = d_wb.Sheets(1).Range("A1").CurrentRegion 'データを配列化
Application.DisplayAlerts = False '警告表示の非表示設定
d_wb.Close 'データを閉じる
Application.DisplayAlerts = True '警告表示の表示設定
last_r = ws_集計データ.Cells(Rows.Count, 1).End(xlUp).Row
'データ貼付け---------------------------------------------
If yesnocancel = 6 Then 'はいの時
For i = 1 To UBound(ary_d, 1)
For j = 1 To UBound(ary_d, 2)
ws_集計データ.Cells(last_r + i, j) = ary_d(i, j)
Next j
Next i
ElseIf yesnocancel = 7 Then 'いいえの時
If c = 0 Then '最初だけ先頭行を含める
c = 1
For i = 1 To UBound(ary_d, 1)
For j = 1 To UBound(ary_d, 2)
ws_集計データ.Cells(last_r + i, j) = ary_d(i, j)
Next j
Next i
ElseIf c = 1 Then '次項は含めずにデータを集計する
For i = 2 To UBound(ary_d, 1)
last_r = ws_集計データ.Cells(Rows.Count, 1).End(xlUp).Row + 1
For j = 1 To UBound(ary_d, 2)
ws_集計データ.Cells(last_r, j) = ary_d(i, j)
Next j
Next i
End If
End If
'-----------------------------------------------------------
n_file = Dir() '次のファイル名を取得
Loop
ws_集計データ.Rows(1).Delete '空白の先頭行を削除
ws_集計データ.Activate
MsgBox "集計完了"
End Sub
※うまく動かない場合はコメントでください
コメント