みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルVBAでConsolidate

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

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

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

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

投稿日時 - 2006-06-13 11:20:54

QNo.2212632

暇なときに回答ください

質問者が選んだベストアンサー

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 に飛んでいることに気付くと
思います。

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

投稿日時 - 2006-06-13 14:23:55

補足

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

投稿日時 - 2006-06-13 16:24:24

お礼

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

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

投稿日時 - 2006-06-13 15:29:58

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.4

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

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

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

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

投稿日時 - 2006-06-13 19:55:01

お礼

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

投稿日時 - 2006-06-14 00:11:05

ANo.2

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

投稿日時 - 2006-06-13 13:55:38

ANo.1

こんにちは。KenKen_SP です。

【質問1 について】

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

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

【質問2 について】

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

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

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

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

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

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

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

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

ということですか?

投稿日時 - 2006-06-13 12:51:00

補足

「開かずに」が重点ではありません。
実は、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

投稿日時 - 2006-06-13 13:20:40

お礼

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

投稿日時 - 2006-06-13 13:32:27

あなたにオススメの質問