VBAで複数のファイルにあるデータを、1つのファイルにまとめる方法についてご説明します。
例えば同じフォルダ内に年度ごとのファイルで保存されており、且つその中に各月のシートでデータが存在するケースを、1つのファイル(シート)にまとめて集計したい時に使用します。
仮に4年分のファイルで12か月×4年をまとめようとすると48か月分のシートを結合する必要があります。
日別であればその約30倍ともっと多いこともあります。
意外と手動で、ミスなく確実に1つのファイルに結合するのは「難しい作業」です。
同じデータを結合したり、結合漏れが出たりと、人は同じ作業を48回も延々とすると大抵ミスをします。
そんな時にVBAで確実に結合すると処理速度も速く、ミスもなくなります。
1ファイルの複数のシートのデータを1シートにまとめる方法や、サブフォルダのファイルをすべてまとめる方法について下記記事をご覧ください。
今回の方法は1．読み込む方法、2.まとめる方法の2つを分けて説明しますので、まとめるようのファイルに「Sample1」と「Sample2」を標準モジュールに記載して順に実行してもらえると動きます。
1.指定したフォルダ内のファイルをすべて読み込む方法
ファイルを読み込む方法
複数のファイルのデータを一つのファイルにまとめる場合は、基本的な処理は同じであっても細かい処理で分けるといくつかの方法があります。
たとえばフォルダの指定をダイアログで選択する方法や、コード内にフォルダパスを直接入力してしまう方法です。
指定したフォルダ内のファイルを読み込む方法については「指定したフォルダ内のファイルをすべて読み込む」をご覧ください。
今回は直接フォルダを指定してファイルを開く方法を使用します。
今回は指定したフォルダ内のファイルの全シートを、一度すべてまとめるためのファイルに読み込んで1つのシートに統合する処理はまとめるファイル内で行います。
この方法を選択する理由があります。
複数のファイルを操作すること自体が、処理を複雑にしてしまいます。
また、読込先のファイルを直接操作するとなると、ブックの指定も含めより複雑で不安定になります。
そのため、極力処理をメインとなるファイルで処理を行います。
ファイルを全て読み込むサンプルコード
下記コードは指定した大フォルダ内のファイルを順に開いて、開いたファイル内のシートを全て読込元のファイルのシートの末尾のにコピーしてくるコードです。
同一ファイル名が存在する場合は、自動的に2つ目以降はナンバリングされます。
特にファイル名で処理を分岐させない場合は特に処理は不要かと思います。
次のように「C:\Sampleフォルダ」内に2016~2019.xlsxのファイルを格納したフォルダを作成しました。
各ファイルには1月～12月のシートがあり、「日付」「価格」「販売個数」「売上」のデータが日数分あります。
この4ファイル12シートで合計48シートをすべて読込たいと思います。
Sub Sample1()
Dim Filename As String
Dim IsBookOpen As Boolean
Dim OpenBook As Workbook
Dim ShCount As Long
With CreateObject("WScript.Shell")
.CurrentDirectory = "C:\Sampleフォルダ\" 'ここで読み込むフォルダを直接指定する
End With
Filename = Dir("*.xlsx")
Do While Filename <> ""
If Filename <> ThisWorkbook.Name Then
IsBookOpen = False
For Each OpenBook In Workbooks
If OpenBook.Name = Filename Then
IsBookOpen = True
Exit For
End If
Next
If IsBookOpen = False Then
ShCount = ThisWorkbook.Worksheets.Count
Workbooks.Open (Filename), UpdateLinks:=1
Worksheets.Copy after:=ThisWorkbook.Worksheets(ShCount)
Workbooks(Filename).Close savechanges:=False
End If
End If
Filename = Dir()
Loop
End Sub
無事48シート読み込まれました。
各ファイル○月という同じ表記でしたので、同じシート名はナンバリングされています。
コードの説明
「.CurrentDirectory = “C:\Sample\”」でカレントフォルダを指定しています。
本来カレントフォルダの指定は「ChDirプロパティ」を使用しますが、共有ネットワーク上のフォルダに対応できるように「CreateObject(“WScript.Shell”)」を使用しています。
「Dir」関数でファイル名を取得しながら、フォルダ内をループします。
「Workbooks.Open (Filename)」でファイルを開きます。
開いた直後に「Worksheets.Copy after:=ThisWorkbook.Worksheets」でシートをVBAの書かれたファイルにコピーしています。
「Workbooks(Filename).Close savechanges:=False」で開いたファイルを保存しないで閉じます。
2.読み込んだファイルを統合する
フォルダ内のファイルをすべて読み込めたら、次は読み込んだシートを1つのシートに統合する方法です。
統合方法の詳細については「複数のシートのデータを1つのシートに連結する方法」をご覧ください。
まとめるためのシートを用意しますが、ここでは「統合」シートとします。
予め統合シートを用意しておきます。
統合シートにデータが存在しているか判定して、存在していたら一旦データを削除します。
次にデータのあるシートのデータを格納します。
データを格納したら統合シートの最終行に貼り付けます。
これをシート数分繰り返すだけです。
注意点として、Excelの最大行を超えるデータを貼り付けようとした場合にエラーとなるため、最大行を超える場合は統合2というように新たに統合シートを作成して貼り付ける処理を組み込みます。
サンプルコード
次のような形式のデータがあるシートが2016年～2019年の各12ヶ月分で48個ある状態です。
これらのデータを予め用意しておいた「統合シート」にまとめる処理を行います。
Sub Sample2()
Dim i As Long
Dim r As Long
Dim s As Long
Dim Sh As Worksheet
Dim MaxRow As Long
Dim MaxCol As Long
Dim MyArray As Variant
Dim JoinSh As Worksheet
Set JoinSh = Worksheets("統合") '統合シートを変数に格納
JoinSh.Cells.Delete 'すでに統合シートが存在する場合は一旦セルを削除
s = 1 '最大行を超えた場合次の統合シートを作成するための番号
For i = s + 1 To Worksheets.Count 'シートを統合シートの次～末尾までループ
With Worksheets(i) '各月シート
If i = 2 Then
r = 1 '最初だけ項目も取得
Else
r = 2 '最初以外は2行目から取得
End If
MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '1列目で最終行を取得
MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column '1行目で最終列を取得
MyArray = Range(.Cells(r, 1), .Cells(MaxRow, MaxCol)) 'A1～データ末尾まで配列に格納
End With
With JoinSh '統合シート
MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '統合シートの１列目で最終行取得
If MaxRow + UBound(MyArray) > Rows.Count Then '最大行を超える場合の処理
s = s + 1 '統合シートの番号を加算
Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加
ActiveSheet.Name = "統合" & s '名前が同じにならないように番号を追加
Set JoinSh = ActiveSheet '統合シートを変数に格納
MaxRow = JoinSh.Cells(Rows.Count, 1).End(xlUp).Row '統合シートの１列目で最終行取得
End If
If .Cells(1, 1) = "" Then
'最初だけ1行目から貼り付け
Range(.Cells(1, 1), .Cells(UBound(MyArray), MaxCol)) = MyArray
Else
'最初以外は最終行の次に貼り付け
Range(.Cells(MaxRow + 1, 1), .Cells(MaxRow + UBound(MyArray), MaxCol)) = MyArray
End If
End With
Next i
End Sub無事統合シートに読み込んだシートを全てまとめることができました。
コードの説明
基本的にはコード内に説明のコメントを記述していますが、簡単に説明します。
統合シートのデータ削除
「Set JoinSh = Worksheets(“統合”)」で統合シートを変数へ格納しています。
「JoinSh.Cells.Delete」ですでに統合シートにデータが存在する場合は一旦セルを削除します。
「s = 1」は統合シートを追加する数です。
最大行を超えた場合の対策です。
各シートのデータを取得
「For i = s+1 To Worksheets.Count」で統合シートの次のシートから末尾のシートまでループします。
「With Worksheets(i)」でループしたシートをWithでくくります。
「r = 1」と「r = 2」に関しては1行目の項目を最初だけ取得したいために、配列へ格納する範囲を1行目からか2行目からか分岐させるためです。
「MyArray = Range(.Cells(r, 1), .Cells(MaxRow, MaxCol))」で指定しているシートのデータを配列に格納しています。
最大行を超える判定
「If MaxRow + UBound(MyArray) > Rows.Count Then」で貼り付ける領域が最大行を変えるか判定しています。
超えた場合は「s」を加算して新たに統合シートを追加します。
統合シートへデータを貼り付け
「With JoinSh」で先ほど新規に追加した統合シートでくくります。
「If .Cells(1, 1) = “” Then」で1行目が空白の場合は1行目から貼り付けるための分岐です。
「Range(.Cells(1, 1), .Cells(UBound(MyArray), MaxCol)) = MyArray」で配列を統合シートへ貼り付けますが、必ず配列の領域と貼り付けるセルの範囲は一緒になるように指定します。
「Range(.Cells(MaxRow + 1, 1), .Cells(MaxRow + UBound(MyArray), MaxCol)) = MyArray」が少し複雑です。
赤字の「MaxRow + 1」は最終行の次の行を指定しています。
青字の「MaxRow + UBound(MyArray)」の部分は最終行+配列の領域(行数)を加算した行数を指定してます。
最終行からスタートして、配列の行数分加算した行まで貼り付けるためです。
以上で複数のシートのデータを1つのシートへまとめる処理となります。
読み込んだシートを削除する処理は組み込んでいません。
文頭でも記載していますが、今回の方法は1．読み込む方法、2.まとめる方法の2つを分けて説明しますので、まとめるようのファイルに「Sample1」と「Sample2」を標準モジュールに記載して順に実行してもらえると動きます。
記述方法次第かと思いますので、ご自身の使いやすい方法にカスタマイズしてみてください。
