VBAで複数のブックを開かずに処理する方法

いつもお世話になっていますm(_ _)m

過去ログやVBAに関するサイトで調べたのですが
分らないので、教えて頂きたいです。

同じフォルダ内にある複数ブックの特定シートから
開かずに値を参照して、開いてるブックの「出力」という
シートに書き出しするプログラムを作成しています。

複数のブックにある特定シートは「見積」
と言う名前の物がありフォルダ内のブックの数は不特定です。
シートから参照する値はほぼ同じなのですが、
３つのフォーマット(取得する項目などが違う等)で値が
入力されているので条件分岐で処理を分ける必要があります。

別ブックを開かずに、ここまで複雑に参照する事は
可能なのでしょうか？自分なりに色々調べたのですが
FormulaR1C1で参照可能までは部分までは
調べたのですが、いざ組んでみるとエラーが出て
条件分岐にすら至らない状態です。

繰り返し処理で一つづつブックを開いて参照しながら
やるべきかと思い、Workbook Openで組んでみましたが
別のブック扱いなので、やはりエラーが出て悩んでます。
自分としては、どちらの処理でも構わないと思っています。

乱文で分りづらいかと思いますので、追ってソースなど
付け加えさせていただきたいと思います。
現文章で、なにか助言いただける方がいましたら
どうぞ宜しくお願いしますm(_ _)m

No.4 回答者： papayuka 回答日時： 2005/03/13 02:04

#2です。

ここまで書けるなら、単なるポカでしょうか？

　For i = 1 To ListTotal
　　i = i - 1

これだと i はどうなります？
For の変数をループの中で操作すると思わぬ落とし穴にハマります。

また、List の最初のIndexは 0 ですので ListCount値までループを繰り返す事は出来ません。
ListCountが 5 でも、List の Index は0～4です。

それに その後の IF文で Else が無い事を考えると i と Cells の変数を別け、最終行を常に見にいった方が確実に思えます。

　For i = 0 To ListTotal - 1
'　 i = i - 1
　　j = Workbooks("出力.xls").Sheets("出力用データ"). _
　　　　　　Cells(65536, 10).End(xlUp).Offset(1, 0).Row
　　FileDate = ChangeCsvForm.ExlFilesListBox.List(i)
　　Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & FileDate)
　　　If Worksheets("見積").Range("A5") = "A" Then
　　　　 Workbooks("出力.xls").Sheets("出力用データ").Cells(j, 10).Value _
　　　　　　= Worksheets("見積").Range("B2").Value

この回答へのお礼

papayukaさん、度々の助言ありがとうございますm(_ _)m

おっしゃる通り、単なるポカみたいです（＾＾；
Listの最初が０なので、1 To ●●　を極当たり前の
ように使っていて、リストの最初のファイル名を
取得してこないので、単純に-1でループ内に
入れてしまっていた事が、悩みの原因だったようで。。。
ご指摘ありがとうございました。

papayukaさんの参考ソースで変更したところ
上手く処理が出来るようになりましたm(_ _)m
また何かありましたら宜しくお願いします。

お礼日時：2005/03/13 11:29

No.3 回答者： taocat 回答日時： 2005/03/13 01:27

こんばんは。

For i = 1 To ListTotal
i = i - 1

この　i=i-1　が原因です。
スタートで　i = 0　になるので後のIF文
　
If Worksheets("見積").Range("A5") = "A" Then
Workbooks("出力").Sheets("出力用データ").Cells(i, 10).Value

の　Cells(i,10)　は　Cells( 0, 10 )　となりエラー。


それよりも大問題があります。

i = i - 1　では永久ループになりませんか？

R = i - 1　とか別の変数で受けるべきだと思いますが。

以上です。

この回答へのお礼

taocatさん、回答ありがとうございますm(_ _)m

よもや、ループカウンターに落とし穴があるとは
気づいてすらいませんでした。
まだまだ勉強不足ですね（＾＾；

また何かありましたら、宜しくお願いします。

お礼日時：2005/03/13 11:20

No.2 ベストアンサー 回答者： papayuka 回答日時： 2005/03/12 16:32

例えば、同一フォルダ内にあるBook1、Book2、Book3のそれぞれSheet1のA1にある値を抜き出すとしたらこんな感じで出来ますが、、、

マクロを記述したブックを必ず上記ファイルと同じフォルダに保存してから実行します。

Sub Test()
　For i = 1 To 3
　　Range("A" & i).Value = _
　　　　"='" & ThisWorkbook.Path & _
　　　　"\[Book" & i & ".xls]Sheet1'!A1"
　　Range("A" & i).Value = Range("A" & i).Value
　Next i
End Sub

> やるべきかと思い、Workbook Openで組んでみましたが
> 別のブック扱いなので、やはりエラーが出て悩んでます。
> 自分としては、どちらの処理でも構わないと思っています。

Open 出来るなら、変数に代入して処理すれば良いのです。

Sub Test1()
Dim wb As Workbook
　Set wb = Workbooks.Open(ThisWorkbook.Path & "\Book1.xls")
　MsgBox wb.Name & "の最初のシートは" & vbCrLf & wb.Worksheets(1).Name
　MsgBox wb.Name & "を閉じます", vbInformation
　wb.Close
End Sub

この回答への補足

papayukaさん、説明不足な内容に
２つの方法を教えて頂きありがとうございます。

教えて頂いた方法は知らなかった訳ではないのですが
処理上の問題なのか、上手く動作してくれなかったのです。

まず以下のプログラムでユーザーフォームのリストボックスに
フォルダ内のプログラム実行ファイル以外を読み込ませています。

'***************[ 取込み ]***************

Private Sub GetSheetsButton_Click()

Dim exBookPath As String
Dim exlBook As String
Dim nCount As Integer

'■ 絶対パスの取得
exBookPath = ThisWorkbook.Path

'■ エクセルファイルのみをDir関数で取得
exlBook = Trim(Dir(exBookPath & "\" & "*.xls", 16))

If exlBook = "" Then
MsgBox "ファイルがありません！"
Exit Sub
End If

'■ リストの初期化
ChangeCsvForm.ExlFilesListBox.Clear

'■ 見積関連のエクセルブック取込み
nCount = 1
Do While exlBook <> ""
If Left(exlBook, 2) <> "出力" Then
ExlFilesListBox.AddItem exlBook
End If
exlBook = Dir
nCount = nCount + 1
Loop
End Sub

このリストカウントを元に、出力を行いたくプログラムを
以下で組みましたが上手くいきません。
根本的に何かを間違ってるとは思うのですが。。。。。

'***************[ 一括出力 ]***************

Private Sub DateOutputButton_Click()

Dim i As Integer
Dim ListTotal As Integer
Dim ChoiceBtn As String
Dim FileDate As String
Dim wb As Workbook


'■ 出力の有無を確認
ChoiceBtn = MsgBox("リスト内のファイルデータを出力します。宜しいですか？", vbYesNo)

If ChoiceBtn = 7 Then
Exit Sub
End If

ListTotal = ChangeCsvForm.ExlFilesListBox.ListCount

'■ リストにデータが無い場合の処理
If ListTotal = 0 Then
MsgBox ("リスト内にブックデータが存在しません！")
Exit Sub
End If

For i = 1 To ListTotal
i = i - 1
FileDate = ChangeCsvForm.ExlFilesListBox.List(i)
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & FileDate)
If Worksheets("見積").Range("A5") = "A" Then
Workbooks("出力").Sheets("出力用データ").Cells(i, 10).Value _
= Worksheets("見積").Range("B2").Value
ElseIf Worksheets("見積").Range("A5") = "B" Then
Workbooks("出力").Sheets("出力用データ").Cells(i, 10).Value _
= Worksheets("見積").Range("B3").Value
ElseIf Worksheets("見積").Range("A5") = "C" Then
Workbooks("出力").Sheets("出力用データ").Cells(i, 10).Value _
= Worksheets("見積").Range("B4").Value
End If
Next i
End Sub

説明用にブック・シート・セルの取得などは仮の物です。
また、テスト段階で更に複雑に処理する事になります。
このプログラムをステップで確認していくと
条件分岐の所で「インデックスが有効ではない」エラーが
発生します。とても初歩的な内容かもしれませんが。。。

このような感じで、先に進めずに困り果てている状態です。
自分なりに色々調べてみたりはしてるのですが
要求内容が複雑なので、助言頂ければ助かります。
宜しくお願いします。

補足日時：2005/03/13 00:19

No.1 回答者： bin-chan 回答日時： 2005/03/12 15:52

開いては行けない理由とは何ですか？

開いて処理するならば、目的の処理が実現できている、と読めますが。

ScreenUpdating = False を設定すれば、画面上では
更新中画面が「見えなく」なりますのでお試しください。
終了時にはScreenUpdating = Trueを忘れずに。

この回答への補足

bin-chanさん、回答ありがとうございます。

>開いては行けない理由とは何ですか？

説明不足で申し訳ないです。
特に開いてはいけない理由はありません。
開いても開かなくてもエラーになるので
ご質問させていただきました。

補足日時：2005/03/13 00:22