エクセルVBAでConsolidate

質問

以下は、ネット検索で見つけたサンプルコードです。
同じフォルダ内の全ブックのSheet１のA1:B10をThisWorkbookのSheet１に統合しています。

Sub test2()
Dim MyFile As String, MyPath As String
Dim SumFile() As Variant, i As Long
MyPath = ThisWorkbook.Path & "\"
MyFile = Dir(MyPath, vbNormal)
Do Until MyFile = ""
If MyFile <> ThisWorkbook.Name Then
ReDim Preserve SumFile(i)
'A1からB10の値を変数に代入
SumFile(i) = "'" & MyPath & "[" & MyFile & "]Sheet1'!R1C1:R10C2"
i = i + 1
End If
MyFile = Dir
Loop
If i = 0 Then MsgBox "データが有りません": Exit Sub
Worksheets("Sheet1").Range("A1").Consolidate Sources:=SumFile()
End Sub

質問１
Sheet1だけでなく全シートのA1:B10をThisWorkbookのSheet１に統合するためにはどう書き換えればよいのでしょうか？

質問２
上記コードではなぜ、ブックを開かずにデータがとれるのでしょうか？

回答No.3

KenKen_SP · ベストアンサー

merlionXX さんは ヘルプなどのドキュメントをご自分で調べる方だと思います。
十分なスキルがありますので、基本的なことは説明しません。

が、何故かデバッグの方法を教えてくれる人やドキュメントはなかなか見ませ
んね、、、

良い機会なので、デバッグ のアドバイス です。

　　1.　On Error ～ ステートメント は コメントアウト しておく
　　2.　VBE の ローカルウインドウ を表示
　　3.　再度実行し、エラー 停止時の変数を ローカルウインドウ で チェック

この様にして、#1 補足欄のコードを実行し、エラー停止時の変数の状況をチェック
します。すると、オブジェクト変数 wb が Nothing になっていました。

これが原因で wb.Close に失敗しています。

次に wb が何故 Nothing になってしまったかを検証します。

今度はプロシージャを 「ステップイン」で一行ずつ実行してみます。
F8 キーを押すことで順次コードを実行していきますので、これでプログラムの流れ
がわかります。

すると、MyFile = Dir(MyPath, vbNormal) で返されたファイル名が
ThisWorkbook と一致した場合、

If MyFile <> ThisWorkbook.Name Then　～　End If

内に書かれた Set wb = ～ をすり抜けて wb.Close に飛んでいることに気付くと
思います。

このような手順で行ってみて下さい。

お礼

デバックの方法までご丁寧にありがとうございます。
#2でご教示のコードを動かしたところ、やはり同じところがエラーになりました。「インデックスが有効範囲に無い」というエラーです。
SumFile(i) = "'" & MyPath & "[" & MyFile & "]" & sn & "'!R1C1:R10C2" '←ここでエラー！！

ご教示のF8で順次コードを実行して見ていくと、最初のブックの2枚目のシートにきたところでエラーが出ます。でも変数にはすべて値が入っておりなぜかわかりません。(゜〇゜;)?
どこが悪いのでしょうか？

補足

わかりました！
ReDim Preserve SumFile(i)の位置が悪いんですね？
For Nextの中にもっていかないと配列のワクが広がらないからインデックスエラーなんですね？

回答No.4

KenKen_SP

> For Nextの中にもっていかないと配列のワクが広がらないから
> インデックスエラーなんですね？

ああ、、見落としてましたね。

こちらでは、1 ブック １シートの手抜きテストだったものです
から、、すみません。その通りです。完全にスルーしてました。
(^^;)

あと、掲示板で質問するときは、エラーメッセージの内容か、
エラー番号を教えてもらえると話が通りやすくなりますよ。

お礼

ありがとうございました。
原因の究明もでき、無事解決ですっきりです。

回答No.2

KenKen_SP

wb.Close の位置が違います。

それから、コードで直した方が良いと思う点が幾つかありました。ご参考
下さい。

Sub test2()

　　Dim MyFile　　As String
　　Dim MyPath　　As String
　　Dim sn　　　　As String
　　Dim SumFile() As Variant
　　Dim i　　　　 As Long
　　Dim wb　　　　As Workbook
　　Dim sh　　　　As Worksheet '<-- ココ

　　MyPath = ThisWorkbook.Path & "\"
　　MyFile = Dir(MyPath & "*.xls", vbNormal) '<-- ココ

　　Do Until MyFile = ""
　　　　If MyFile <> ThisWorkbook.Name Then
　　　　　　ReDim Preserve SumFile(i)
　　　　　　'選択したファイルをLink更新なしで開く
　　　　　　Set wb = Workbooks.Open(MyPath & "\" & MyFile, UpdateLinks:=0)
　　　　　　For Each sh In wb.Worksheets
　　　　　　　　sn = sh.Name
　　　　　　　　SumFile(i) = "'" & MyPath & "[" & MyFile & "]" & sn & "'!R1C1:R10C2"
　　　　　　　　i = i + 1
　　　　　　Next
　　　　　　'選択したファイルを閉じる
　　　　　　wb.Close SaveChanges:=False '<-- ココ
　　　　End If
　　　　MyFile = Dir
　　Loop

　　Set wb = Nothing '<-- ココ

　　If i = 0 Then MsgBox "データが有りません": Exit Sub
　　Worksheets("Sheet1").Range("A1").Consolidate Sources:=SumFile()

End Sub

回答No.1

KenKen_SP

こんにちは。KenKen_SP です。

【質問１ について】

　> SumFile(i) = "'" & MyPath & "[" & MyFile & "]Sheet1'!R1C1:R10C2"

　この部分が肝です。全シートを対象にするなら、Sheet1 の部分をループ
　処理で書換えてやれば良いのです。ただ、下記の質問２に関連しますが、
　ブックに含まれるシート名のリストを得るためには、結局ブックを開く
　ことになりますね、、

【質問２ について】

　厳密に言えば、例外なくどんなファイルでも開かずにデータを得ることは
　不可能です。

　しかし、ユーザーに「開く動作」を意識させないことは可能です。

　簡単な例で言えば、Workbooks.Open の動作を Application.ScreenUpdating
　で画面描写を停止させてしまう方法がありますね。「開く動作」を意識させ
　ずに、シートのデータを得る方法は、他にもあります。

　・Excel のリンクを使う　例）='C:\[test.xls]Sheet1'!$A$1
　・ExecuteExcel4Macro メソッド（Excel4.0Macro）を利用する
　・DAO や ADO でブックに接続する
　・バイナリデータを直接解析する

　いずれの場合も、何らかの形でファイルは開いています。

　Consolidate メソッドが内部でどのように問い合わせをしているのか、その
　方法はわかりませんが、同様に「開く」を意識させないように実装されて
　いるだけに過ぎません。

で、つまるところ実現したいことは、、

「 Workbooks.Open を使わずに、シートのデータを取得したい」

ということですか？

お礼

こんにちは。KenKen_SPさん。いつもお世話になります。
長くなりますので、補足の欄に書かせていただきました。
よろしくお願いします。

補足

「開かずに」が重点ではありません。
実は、Sheet1をループ処理するためにWorkbooks.Open で以下のようにしてみたのですがエラーになってしまいました。それで困って質問したのです。

Sub test2()
Dim MyFile As String, MyPath As String, sn As String
Dim SumFile() As Variant, i As Long
Dim wb As Workbook
MyPath = ThisWorkbook.Path & "\"
MyFile = Dir(MyPath, vbNormal)
Do Until MyFile = ""
If MyFile <> ThisWorkbook.Name Then
ReDim Preserve SumFile(i)

Set wb = Workbooks.Open(MyPath & "\" & MyFile, UpdateLinks:=0) '選択したファイルをLink更新なしで開く
For Each sh In wb.Worksheets
sn = sh.Name

SumFile(i) = "'" & MyPath & "[" & MyFile & "]" & sn & "'!R1C1:R10C2" '←ここでエラー！！

i = i + 1
Next

End If

wb.Close '選択したファイルを閉じる
MyFile = Dir
Loop
If i = 0 Then MsgBox "データが有りません": Exit Sub
Worksheets("Sheet1").Range("A1").Consolidate Sources:=SumFile()
End Sub