Excelで月毎にフォルダを作り、その中に日毎の日報用のブックを保存しています。
複数ある日報のブックを1つの月報のブック下図のように集計します。
< スポンサーリンク >
VBEで参照設定を設定する
ファイルシステムオブジェクトを使うので、「Microsoft Scripting Runtime」を有効にします。
[ツール]>[参照設定]をクリックします。
「Microsoft Scripting Runtime」にチェックを入れ、[OK]をクリックします。
複数ブックのデータを一つのブックに集計するVBA
ファイルシステムオブジェクトを使って、日報のブックを1つずつ開いて、集計用のブックに値を入力していきます。
日報の「A1」のセルの値を集計用の「A列」に、日報の「A2」のセルの値を集計用の「B列」に入力するサンプルです。
最終行に「SUM」関数で「合計」を出しています。
Sub shuukei()
'自分のブックのディレクトリPathの変数
Dim DirPath As String
'自分のワークブック用変数
Dim acWb As Workbook
'自分のワークブックの名前用変数
Dim acWbName As String
'自分のワークシート用変数
Dim acWs As Worksheet
'ファイルシステムオブジェクトの変数
Dim FileSysObj As Object
'フォルダ内のブックの変数
Dim FileObj As Object
'アクティブなブック
Dim acFileObj As Object
'アクティブなブックの名前
Dim acFileObjName As String
'順番に開いていくワークブック変数
Dim wb As Workbook
'wbのシート変数
Dim ws As Worksheet
'行
Dim x_row As Long
'自分のブックをセットする
Set acWb = ThisWorkbook
'自分のブックの集計用ワークシートをセットする
Set acWs = acWb.Sheets("Sheet1")
'自分のブックのディレクトリを変数に代入
DirPath = acWb.Path
'自分のブック名を変数に代入
acWbName = acWb.Name
'ファイルシステムオブジェクトのセット
Set FileSysObj = CreateObject("Scripting.FileSystemObject")
'フォルダ内のファイルのセット
Set FileObj = FileSysObj.GetFolder(DirPath).Files
'集計用シート開始行
x_row = 1
'フォルダ内ファイルループ
For Each acFileObj In FileObj
'ファイル名を変数に代入
acFileObjName = acFileObj.Name
'ブック名が自分のブック名と違う場合、一時ファイルではない場合
If acFileObjName <> acWbName And Not acFileObjName Like "~$*" Then
'元データブック開く
Workbooks.Open acFileObj
'元データブックを変数に代入
Set wb = Workbooks(acFileObjName)
Set ws = wb.Worksheets("Sheet1")
'元のブックのA1の値を集計用のA列に入力
acWs.Cells(x_row, 1).Value = ws.Range("A1").Value
'元のブックのA2の値を集計用のB列に入力
acWs.Cells(x_row, 2).Value = ws.Range("A2").Value
'集計用1行増やす
x_row = x_row + 1
'元データブック閉じる
wb.Close
End If
Next
Set acFileObj = Nothing
Set FileObj = Nothing
Set FileSysObj = Nothing
acWs.Cells(x_row, 1).Value = "計"
acWs.Cells(x_row, 2).Formula = "=sum(B1:B" & x_row - 1 & ")"
End Sub
下記は、以前書いていたコードです。Excel2021で操作してみたらエラーが出たので、上記に書き直しました。
Sub shuukei()
‘自分のブックのディレクトリPathの変数
Dim DirPath As String
‘自分のワークブック用変数
Dim acWb As Workbook
‘自分のワークブックの名前用変数
Dim acWbName As String
‘自分のワークシート用変数
Dim acWs As Worksheet
‘ファイルシステムオブジェクトの変数
Dim FileSysObj As Object
‘フォルダ内のブックの変数
Dim FileObj As Object
‘アクティブなブック
Dim acFileObj As Object
‘アクティブなブックの名前
Dim acFileObjName As String
‘順番に開いていくワークブック変数
Dim wb As Workbook
‘wbのシート変数
Dim ws As Worksheet
‘行
Dim row As Integer
‘自分のブックをセットする
Set acWb = ThisWorkbook
‘自分のブックの集計用ワークシートをセットする
Set acWs = acWb.Sheets(“Sheet1”)
‘自分のブックのディレクトリを変数に代入
DirPath = acWb.Path
‘自分のブック名を変数に代入
acWbName = acWb.Name
‘ファイルシステムオブジェクトのセット
Set FileSysObj = CreateObject(“Scripting.FileSystemObject”)
‘フォルダ内のファイルのセット
Set FileObj = FileSysObj.GetFolder(DirPath).Files
row = 1
For Each acFileObj In FileObj
acFileObjName = acFileObj.Name
‘ブック名が自分のブック名と同じ時は何もしない
If InStr(acFileObjName, acWbName) Then
Else
Workbooks.Open acFileObj
Set wb = Workbooks(acFileObjName)
Set ws = wb.Worksheets(“Sheet1”)
acWs.Range(“A” & row).Value = ws.Range(“A1”).Value
acWs.Range(“B” & row).Value = ws.Range(“A2”).Value
row = row + 1
wb.Close
End If
Next
Set acFileObj = Nothing
Set FileObj = Nothing
Set FileSysObj = Nothing
acWs.Range(“A” & row).Value = “計”
acWs.Range(“B” & row).Formula = “=sum(B1:B” & row – 1 & “)”
End Sub
こんな記事も書いています