同じフォルダにある５０個のブックのそれぞれ５0枚のシートの集計

質問

同じフォルダに５０個のブックがあり、それぞれのブックが５０枚のシートを持っています。ブック名として人の名前、シート名として地名がつけられています。（つまり、総計で２５００の地名がつけられたシートがあります。）シートは全て同じ形式です。集計用ブックを作りこの２５００枚のシートの同じセルの集計をしたいのですが、どうすればよろしいでしょうか？つまり、２５００枚のシートのＥ１の合計が集計用ブックのＳｈｅｅｔ１のＥ１に入るようにしたいのです。２５００枚のシートのセルには数式が入っていて、ほしいのはその計算結果（Ｖａｌｕｅ）の合計です。また、２５００枚のシートのセルの計算結果が””の場合もあります。難しくなければマクロでも結構ですので、是非教えてください。

回答No.2

merlionXX · ベストアンサー

No1のmerlionXXです。
> （レンジで言うとＩ２：Ｏ６０００）、この場合はマクロでどのように記述すれば・・・・

Range("I2:O6000")を合計するようにしてみました。

Sub test()
Application.ScreenUpdating = False '画面更新を一時停止
Application.Calculation = xlCalculationManual '関数自動計算の停止
Set mb = ThisWorkbook
myfdr = ThisWorkbook.Path
fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelファイルを検索
Do Until fname = Empty '全て検索し終えると、fname = Empty となるので、その間以下を実行
If fname <> mb.Name Then 'ファイル名がこのファイルじゃなければ
Set wb = Workbooks.Open(myfdr & "\" & fname) '選択したファイルを開く
For Each sh In wb.Worksheets
For Each c In sh.Range("I2:O6000")
If c <> "" And IsNumeric(c) Then '数値であれば
ad = c.Address
With mb.Sheets("Sheet1").Range(ad)
.Value = .Value + c.Value '集計シートに加算
End With
End If
Next c
i = i + 1 'シート枚数をカウント
Next sh
wb.Close '選択したファイルを閉じる
n = n + 1 'ブック数をカウント
End If
fname = Dir '選択したフォルダ内の次のExcelファイルを検索します
Loop '繰り返す
Application.Calculation = xlCalculationAutomatic '関数自動計算の停止を解除
Application.ScreenUpdating = True '画面更新一時停止を解除
MsgBox n & "件のブックの　" & i & "枚のシートを集計しました。"
Set mb = Nothing
End Sub

補足

ご丁寧に解説いただいたのに少し時間がかかってしまい申し訳ありませんでした。（相当に悪戦苦闘して、色々と勉強になりました。）最終的には問題が二つに絞られていて、そこさえ解決すれば完璧というところまで来ました。一つはブックを開くときに「リンクを更新しますか？」と聞かれてしまうことです。はい、いいえをマクロ中で自動的に選択するようにしたいのですが、こういうことは可能なのでしょうか？もう一点は処理速度で、結構遅くてちょっと参っています。（ちなみに、統合するために送られてくるエクセルブックは１つで３００ＭＢ近くになり、それが４０あるということが分かりました。）計測したところ、前記の「リンクの更新」のマクロ化が出来れば１時間程度になりそうです。処理速度を上げる工夫は何かありますか？

ご丁寧な解説を頂いた事に甘えてしまいますが、あまりお手数をかけない範囲でお答えいただけるなら是非お願い致します。

回答No.4

merlionXX

もう一点。
少しでも早くするために、カウントが不要だったら

i = i + 1 'シート枚数をカウント
n = n + 1 'ブック数をカウント

の2つを削除してみてください。
当然、MsgBox n & "件のブックの　" & i & "枚のシートを集計しました。"　も不要になりますが。

お礼

色々とありがとうございました。速度の問題は依然として残りますがどうにか使えるものを作ることが出来ました。深くお礼申し上げます。

回答No.3

merlionXX

>「リンクを更新しますか？」と聞かれてしまうことです。

それはわたしのコードに原因があるんじゃなく、もともとリンクが設定されているファイルを開くからそうなるのでは？手動で開いたって出るでしょう？

> はい、いいえをマクロ中で自動的に選択するようにしたいのですが、こういうことは可能なのでしょうか？

送られてきたファイルなら更新なんてできないでしょ？「いいえ」しかないですね？
８行目あたりのコードを以下のように変更してみてください。

Set wb = Workbooks.Open(myfdr & "\" & fname, UpdateLinks:=0) '選択したファイルをLink更新なしで開く

> 処理速度で、結構遅くてちょっと参っています。

わたしのコードではもうすでに、

Application.ScreenUpdating = False '画面更新を一時停止
Application.Calculation = xlCalculationManual '関数自動計算の停止

で、高速化を図っていましたが、そんな巨大なデータなら焼け石に水ですね。
素人に毛の生えた程度のわたしの力量では思いつきません。
この質問はすでに時間が経ち過ぎたのでもう見る人もいないでしょうから、一旦締め切って、新たに「マクロを高速化したい」と質問をしたらいかがでしょうか？（この質問Noにリンクをさせておけば説明も早いかと思います。）

回答No.1

merlionXX

これはやはりマクロの出番でしょうね。

集計用のブックに下記のVBAを仕組み、同じフォルダにいれて、いったん保存してから実行してみてください。
集計用ブックの集計用シート名はSheet1とします。

集計される方のブックの名前、件数、シート数は別に問いません。
フォルダー内の集計用ブック以外の全ブック、全シートを対象にします。

Sub test()
Application.ScreenUpdating = False '画面更新を一時停止
Set mb = ThisWorkbook
myfdr = ThisWorkbook.Path
fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelファイルを検索
Do Until fname = Empty '全て検索し終えると、fname = Empty となるので、その間以下を実行
If fname <> mb.Name Then 'ファイル名がこのファイルじゃなければ
Set wb = Workbooks.Open(myfdr & "\" & fname) '選択したファイルを開く
For Each sh In wb.Worksheets
If sh.Range("E1") <> "" Then 'E1が空白でなければ
With mb.Sheets("Sheet1").Range("E1")
.Value = .Value + sh.Range("E1").Value '集計シートのE1に加算
i = i + 1 'シート枚数をカウント
End With
End If
Next
wb.Close '選択したファイルを閉じる
n = n + 1 'ブック数をカウント
End If
fname = Dir '選択したフォルダ内の次のExcelファイルを検索します
Loop '繰り返す
Application.ScreenUpdating = True '画面更新一時停止を解除
MsgBox n & "件のブックの　" & i & "枚のシートを集計しました。"
End Sub

元データのバックアップを必ずとってから実行してみて下さい。

補足

ありがとうございました。テスト版では何とか成功しました。実際には集計するべきセルの数相当数であるのですが（レンジで言うとＩ２：Ｏ６０００）、この場合はマクロでどのように記述すれば良いのか合わせてお教え頂ければ幸いです。