[[20150213152929]]　『フォルダ内のファイルを1つのファイルに合計』（さち）　ページの最後に飛ぶ

『フォルダ内のファイルを1つのファイルに合計』（さち）

フォルダ内に50ファイルあります。中身の表はすべて同じ形式の表です。
集計用のファイルを作成し、そのファイルを開くと50ファイルの同じセルの値を表示したいです。
EXCELでできますか？

例
D:\データ格納\

１．データ格納フォルダ内に50ﾌｧｲﾙを保存。

    ファイル名「●●支店.xlsx」
　　　　　　    ：
　　　　　    　：

２．●●支店.xlsxの中身

       A       B      C
1　 　製品　　数量　　金額
2  　あああ　　500　　10000
3  　いいい　　300　　80000
4  　ううう　　400　　70000
5　　合計　　 1200   160000

３．集計.xlsxを作成し、開くだけで２．のB5、C5の数値が集計.xlsxのB2,C2に表示したい。

また、A列は、ファイル名を表示したいです。

       A       B      C
1　 　支店　　数量　　金額
2  ●●支店　　500　　10000
3  ▲▲支店　　300　　80000
4  ■■支店　　400　　70000
:
50 ××支店　　 30     1000

宜しくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 同じようなことを別のトピックでやっていましたので、簡単に対応可能です。

 １．データは、●●支店.xlsxの何と云うシート名に書かれていますか？
 　　シートが1枚しかないブックなら、その情報は必要ないですけど。。。

 ＞集計.xlsxを作成し
 ２．マクロを使うので、拡張子が「xlsmx」の「集計.xlsm」になります。
 　それとも、社内でマクロありブックは禁止されていますか？

（半平太） 2015/02/13(金) 16:18

ありがとうございます。
１．シート名は50ファイルとも共通で「提出用」です。

２．xlsmは社内で使用可能です。

宜しくお願いします。

 2/14 8:25 追記。

 あれ？　半平太さんのコードが消えている？
 何度か、私がアップしたものを編集で訂正したんですが、間違えて消してしまっていたら
 大変申し訳ないことです・・・・・

 コードにバグ発見。ブックの抽出が１つ少なくなるコードでした。
 新しくアップしますと、スレが長くなるだけですので、コード部分だけ入れ替えます。

 参加賞狙いで。

 とりあえず標準モジュールに書いて試してください。
 ブックを開いたときに処理するということなので、実際には、このマクロの中身（Sub Sample と End Sub を除いた部分）を
 Workbook_Open の中に書きます。

 データブックを格納するフォルダのパスは実際のものに変更願います。
 コードの中では DeskTop上の　データ格納　という名前のフォルダにしています。

 進行状況はエクセル画面の下のステータスバーに表示しています。

 Sub Sample()
    Dim dPath As String
    Dim temp As String
    Dim WSH As Object
    Dim rtn As Long
    Dim f As Integer
    Dim buf() As Byte
    Dim fList As Variant
    Dim fTot As Long
    Dim fCnt As Long
    Dim dSh As Worksheet
    Dim listV As Variant
    Dim tSh As Worksheet
    Dim i As Long

    dPath = Environ("USERPROFILE") & "\DeskTop\データ格納\"     'データブックのフォルダ　実際のパスに書き換え
    temp = Environ$("Temp") & "\Dir.tmp"        '作業用一時ファイルパス
    Set WSH = CreateObject("WScript.Shell")
    'ブック情報の一括取得
    rtn = WSH.Run("CMD /C DIR """ & dPath & "*.xls*" _
        & """ /A-D /B /S > """ & temp & """", 7, True)
    Set WSH = Nothing

    If rtn <> 0 Then
        MsgBox "申しわけありません。集約に失敗しました"
        Exit Sub
    End If

    f = FreeFile()
    Open temp For Binary As f
    ReDim buf(1 To LOF(f))
    Get #f, , buf
    Close #f
    Kill temp

    fList = Split(StrConv(buf, vbUnicode), vbCrLf)
    fTot = UBound(fList)
    ReDim listV(1 To fTot)

    Application.ScreenUpdating = False
    Set tSh = ThisWorkbook.Sheets(1)
    tSh.UsedRange.ClearContents
    tSh.Range("A1:C1").Value = Array("支店", "数量", "金額")

    For fCnt = LBound(fList) To UBound(fList) - 1
        Application.StatusBar = fCnt + 1 & "個目/" & fTot & "個中　のブック処理をしています..."
        Set dSh = Workbooks.Open(fList(fCnt)).Sheets("Sheet1")
        With dSh.Range("A1").CurrentRegion
            listV(fCnt + 1) = .Rows(.Rows.Count).Range("A1:C1").Value
            listV(fCnt + 1)(1, 1) = Left(dSh.Parent.Name, InStr(dSh.Parent.Name, ".") - 1)
        End With
        dSh.Parent.Close False
    Next

    tSh.Range("A2").Resize(UBound(listV), 3).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(listV))
    Application.StatusBar = False

 End Sub

（β） 2015/02/13(金) 21:05

 こんにちは
 対象フォルダが D:\データ格納\ で、その下にサブフォルダはないなら、
 こんな風に Dir関数のLoopでもできますね。
 非表示のリストに抽出して、最後に リストを新規シートに展開しています。

 Sub Book合計値集約()
    Dim dPath As String: dPath = "D:\データ格納\" '◆対象フォルダパス名 （お尻に \ が必要）
    Dim f As String
    Dim wb As Workbook
    Dim c As Range
    Dim k As Long

    Application.ScreenUpdating = False
    k = 0
    With CreateObject("Forms.ComboBox.1") '支店別数量・金額リストの作成
        .AddItem "支店"     '集約表 タイトル行
        .List(k, 1) = "数量"
        .List(k, 2) = "金額"

        f = Dir$(dPath & "*.xls*")
        Do Until Len(f) = 0
            k = k + 1
            .AddItem Left$(f, InStrRev(f, ".") - 1) 'ファイル名(支店名)
            Set wb = Workbooks.Open(dPath & f)
            Set c = wb.Worksheets(1).Cells(Rows.Count, 1).End(xlUp)
            .List(k, 1) = c(1, 2).Value      '合計数量
            .List(k, 2) = c(1, 3).Value      '合計金額
            wb.Close False
            f = Dir$()
        Loop
        'このBookの新規シートに 抽出結果貼り付け
        Set c = ThisWorkbook.Worksheets.Add().Range("A1").Resize(k + 1, 3)
        c.Value = .List 'リストを貼り付ける

    End With
    Application.ScreenUpdating = True

 End Sub
 .
（kanabun） 2015/02/14(土) 10:23

 To kanabunさん

 こんにちは

 「対象フォルダが D:\データ格納\ で、その下にサブフォルダはないなら・・・Dir関数のLoopでもできますね。」

 はい。そうですよね。
 実は、私のコードをアップする前に、半平太さんが、コードをアップしておられて、５０ファイルの処理なので
 実行時間が長いと、心配になるかもということで、進捗状況のラベル表示を盛り込んでおられたので、
 私がアップするコードでも、それをなんとかできないかと。
 で、処理前に全体のファイル数を取得するために、Dirコマンドを使いました。
 （このコードのほとんどは、kanabunさんが、以前からよくご紹介されているもののパクリです）

（β） 2015/02/14(土) 11:07

 ＞ あれ？　半平太さんのコードが消えている？
 ＞ 何度か、私がアップしたものを編集で訂正したんですが、間違えて消してしまっていたら
 ＞ 大変申し訳ないことです・・・・・

 済みません。自己削除しました。

 そう書いて置けば良かったと反省しております。　m(__)m

（半平太） 2015/02/14(土) 15:06

コメント返信：

[ 一覧(最新更新順) ]

[[20150213152929]] 『フォルダ内のファイルを1つのファイルに合計』（さち） ページの最後に飛ぶ

[[20150213152929]]　『フォルダ内のファイルを1つのファイルに合計』（さち）　ページの最後に飛ぶ