Excel VBA同じフォルダ内のブックのデータを1つのブックに集計

Excelで月毎にフォルダを作り、その中に日毎の日報用のブックを保存しています。

フォルダ

 

複数ある日報のブックを1つの月報のブック下図のように集計します。

日報月報

 

< スポンサーリンク >





VBEで参照設定を設定する

ファイルシステムオブジェクトを使うので、「Microsoft Scripting Runtime」を有効にします。

[ツール]>[参照設定]をクリックします。

VBE参照設定

「Microsoft Scripting Runtime」にチェックを入れ、[OK]をクリックします。

「Microsoft Scripting Runtime」にチェック

複数ブックのデータを一つのブックに集計する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

 

 

< スポンサーリンク >※広告先のお問い合わせは広告主様にお願いします