VBAで複数あるサブフォルダ内の複数のファイルにあるデータを、1つのファイルにまとめる方法についてご説明します。
例えばフォルダ内に年度ごとのサブフォルダがあり、そのサブフォルダ内に各月のファイルでデータが保存されているようなケースに、1つのファイル(シート)にまとめて集計したい場合などに使用します。
仮に5年分のサブフォルダが存在して12か月分のファイルがあり、その中に日別のシートが存在するような管理方法だった場合を考えてみます。
5年×12ヶ月×日数のシートを結合する必要があります。
仮に単純に5年×365日で考えても1,825シートですよね。
これを手動で1シートにデータをまとめる作業は正直至難の業です。
意外と手動でミスなく確実に1つのファイルに結合するのは「難しい作業」です。
同じデータを結合したり、結合漏れが出たりと、同じ作業を1,825回もミスなく作業できる人はなかなかいないのではないでしょうか。
そんな時にVBAで確実に結合すると処理速度も速く、ミスもなくなります。
今回の方法は1．サブフォルダのファイルを読み込む方法、2.まとめる方法の2つを分けて説明しますので、まとめるようのファイルに「Sample3」と「Sample4」を標準モジュールに記載して、読み込みたいフォルダを変更してから、順に実行してもらえると動きます。
1ファイルの複数のシートのデータを1シートにまとめる方法や、直下のフォルダのファイルをすべてまとめる方法については下記記事をご覧ください。
1.指定したフォルダ内のサブフォルダのファイルすべて読み込む方法
サブフォルダの取得方法については、フォルダを指定してサブフォルダを取得するという処理となり、基本的には同じですがダイアログで指定する方法や、直接コードで指定する方法などフォルダの指定方法がいくつかあります。
今回は直接フォルダを指定する方法を使用します。
読み込むコードはSample3が完成形です。
サブフォルダのファイルを開く方法については「指定フォルダ内のサブフォルダを全て取得してファイルを開く」をご覧ください。
サブフォルダの取得方法
サブフォルダ内のファイルを取得するには、サブフォルダを取得する必要があります。
ですが、その前にサブではなくメインのフォルダを取得する必要があり、このメインのフォルダを指定することで、あとは動的にサブフォルダとファイルを、取得することが可能となります。
メインのフォルダを指定する
フォルダを指定するには「CreateObject(“WScript.Shell”)」で指定します。
本来カレントフォルダの指定は「ChDirプロパティ」を使用しますが、共有ネットワーク上のフォルダに対応できるように「CreateObject(“WScript.Shell”)」を使用しています。
Sub Sample1()
With CreateObject("WScript.Shell")
.CurrentDirectory = "C:\Sampleフォルダ\"
End With
End Sub指定したフォルダ内のサブフォルダを取得する
さて、メインのフォルダを指定したら、次はフォルダ内のサブフォルダの取得です。
フォルダ内のサブフォルダを取得する方法は「FileSystemObject」を使用します。
フォルダを取得するには「GetFolder」関数を使用します。
GetFolderで取得したフォルダ内のサブフォルダを、「SubFolders」コレクションですべてループします。
GetFolderはフォルダーがない場合にエラーとなりますので、エラー処理が必要です。
次のコードは直接コードで指定したフォルダ内のサブフォルダ名をすべて取得して、イミディエイトに表示します。
Sub Sample2()
Dim myFolder As Variant
Dim Fso As Object
Dim GetFolder As Object
Dim Fol As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
With CreateObject("WScript.Shell")
.CurrentDirectory = "C:\Sampleフォルダ\"
End With
Set GetFolder = Fso.GetFolder("C:\Sampleフォルダ\")
For Each Fol In GetFolder.SubFolders
Debug.Print Fol.Name
Next
Set GetFolder = Nothing
End Subサブフォルダ内のファイルをすべて読み込む
サブフォルダを取得出来ましたので、次はサブフォルダ内のフィアルを全て読み込む方法です。
これが出来てしまえば、あとはシートにまとめるだけになります。
Sub Sample3()
Dim myFolder As Variant
Dim Fso As Object
Dim GetFolder As Object
Dim Fol As Object
Dim Filename As String
Dim IsBookOpen As Boolean
Dim OpenBook As Workbook
Dim ShCount As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
With CreateObject("WScript.Shell")
.CurrentDirectory = "C:\Sampleフォルダ\" 'メインとなるフォルダを指定(※ここを変更する)
End With
Set GetFolder = Fso.GetFolder("C:\Sampleフォルダ\")
For Each Fol In GetFolder.SubFolders 'サブフォルダをループ
With CreateObject("WScript.Shell")
.CurrentDirectory = Fol 'サブフォルダをカレントフォルダに指定
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
Next
Set GetFolder = Nothing
End Sub統合シートの後ろに各サブフォルダ内のファイルを全て読み込む事が出来ました。
コードの説明
少し長いので、簡単にコードの説明です。
「.CurrentDirectory = “C:\Sampleフォルダ\”」でフォルダを指定します。
「GetFolder.SubFolders」で指定されたフォルダのサブフォルダを、取得してループします。
「.CurrentDirectory = Fol」でコレクションから取得したサブフォルダをカレントフォルダにして、フォルダ内のファイルをループで取得しています。
これですべてのサブフォルダ内のファイルを読み込むことができました。
2.読み込んだファイルを統合する
サブフォルダ内のファイルをすべて読み込めたら、次は読み込んだシートを1つのシートに統合する方法です。
統合方法の詳細については「複数のシートのデータを1つのシートに連結する方法」をご覧ください。
まとめるためのシートを用意しますが、ここでは「統合」シートとします。
統合シートを作成したら、次はデータのあるシートのデータを格納します。
データを格納したら統合シートの最終行に貼り付けます。
これをシート数分繰り返すだけです。
注意点として、Excelの最大行を超えるデータを貼り付けようとした場合にエラーとなるため、最大行を超える場合は統合2というように新たに統合シートを作成して貼り付ける処理を組み込みます。
サンプルコード
上記で読み込んだように、次の形式のデータがあるシートが2016年～2019年の各12ヶ月分で48個ある状態です。
これらのデータを予め用意しておいた「統合シート」にまとめる処理を行います。
Sub Sample4()
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つを分けて説明しますので、まとめるようのファイルに「Sample3」と「Sample4」を標準モジュールに記載して、指定するフォルダを変更して、順に実行してもらえると動きます。
記述方法次第かと思いますので、ご自身の使いやすい方法にカスタマイズしてみてください。
