エクセルVBAで、複数のブックからデータベースを作りたい

質問

こんにちは。ＶＢＡをはじめたばかりの者です。
変数の使い方で教えていただきたいことがあります。

Dim myFLName As String

myFLName = ThisWorkbook.Path & "\001.xls"
Workbooks.Open Filename:=myFLName, ReadOnly:=True
Workbooks("dbase.xls").Activate

Range("A2").Select
ActiveCell.Value = 1
ActiveCell.Offset(, 1).Select
ActiveCell.Value = Workbooks("001.xls").Worksheets(1).Range("R3")
ActiveCell.Offset(, 1).Select
ActiveCell.Value = Workbooks("001.xls").Worksheets(1).Range("C2")
ActiveCell.Offset(, 1).Select
ActiveCell.Value = Workbooks("001.xls").Worksheets(1).Range("R2")
ActiveCell.Offset(1, -3).Select

001.xls～（連番でない）200.xlsくらいまでのファイルがあり、
同じフォルダにdbase.xlsを作って1ブックから１レコードになるようにしたいと
思います。

こんな感じで１行目はできたのですが、２行目の１列目に「2」を入れ、
2列目からは001.xlsの次のブックを開いてセルの中身をコピーしたいのです。

変数の使い方がよくわからないのですが、教えていただけますでしょうか。
よろしくお願いいたします。

回答No.5

Wendy02 · ベストアンサー

#4 の補足

#自ブックのフォルダではなく、別のほうがよいですね。
と書きながら、

きちんと書かれていませんでしたが、
With Workbooks.Open(Fn, , True)

は、別フォルダなら、
With Workbooks.Open(myPath　& Fn, , True)

となります。

お礼

アドバイスありがとうございました。
フォームは別フォルダにまとめてすっきりさせました。
あと、ちょこっと手直ししたら完璧に終了までに至るプロシージャとなりました。

どうもありがとうございました。

回答No.4

Wendy02

こんばんは。

本来は、フォルダは、自ブックのフォルダではなく、別のほうがよいですね。
誰が書いても、だいたい同じようにはなります。しかし、データを吸い上げるブック自体に順序をつける場合は、もう少し工夫が必要です。

'一応、標準モジュールのほうが良いです。

Sub TestMacro1()
　　Dim Fn As String
　　Dim myPath As String
　　Dim dbBkSh As Worksheet
　　Dim i As Long
　　Set dbBkSh = Workbooks("dbase.xls").Worksheets(1)
　　myPath = ThisWorkbook.Path & "\"
　　Fn = Dir(myPath & "*.xls")
　　i = 1
　　'画面のちらつきを抑える
　　Application.ScreenUpdating = False
　　Do Until Fn = ""
　　　　If Fn <> ThisWorkbook.Name Then
　　　　　　With Workbooks.Open(Fn, , True)
　　　　　　　　dbBkSh.Range("A1").Offset(i, 0).Value = i
　　　　　　　　'B2 - sh.R3
　　　　　　　　dbBkSh.Range("A1").Offset(i, 1).Value = .Worksheets(1).Range("R3").Value
　　　　　　　　'C2 - sh.C2
　　　　　　　　dbBkSh.Range("A1").Offset(i, 2).Value = .Worksheets(1).Range("C2").Value
　　　　　　　　'D2- sh.R2
　　　　　　　　dbBkSh.Range("A1").Offset(i, 3).Value = .Worksheets(1).Range("R2").Value
　　　　　　　　.Close False
　　　　　　　　i = i + 1
　　　　　　End With
　　　　End If
　　　　Fn = Dir()
　　Loop
　　Application.ScreenUpdating = True
　　Set dbBkSh = Nothing

End Sub

お礼

アドバイスありがとうございます。
わからないことばかりなので、いろいろ調べながら、勉強させていただきます。

回答No.3

-yellowtail-

#1です。
すみません。そのエラーはキチンと場所を指定していないから起こっています。
Workbooks("xxx").Sheets("xxx").Cells(…)とシートを指定して下さい。
私も初心者の時は悩みまくり、本見まくり、ネットサーフィンしまくりでした。
ちなみにもし、オブジェクトが理解できるようでしたら、ぜひこの場合Workbookオブジェクトを使うといいと思います。
Dim WB as Workbook
とWBという変数をワークブックオブジェクトとして定義します。
そしてSet WB = Workbooks.open("ファイルのフルパス")と言う形でセットします。
やってることは同じですが、こういうところから覚えていくとあとあと楽になると思うのでこの機会にゼヒ。
（たとえば新規ファイルをいくつか作ったらどうやって指定するの？みたいな話になった時、Set WB = workbooks.Add　と指定できたりするので）
それから、上記のコードそのままやると、私ブックを閉じるのを忘れているので200個のブックが開きっぱなしになります。
fn=dir()の前にブックを閉じる処理を入れて下さい。
Workbooks(fn).Close false
WB.Close False　←オブジェクトならこう！簡単になります☆

お礼

ご回答ありがとうございます。
ワークシートの指定が必要だったんですね。

オブジェクト、早速試してみます！

回答No.2

imogasi

やりたいことが、読者側で良くコードを読まないとわかりにくい。
（A)やりたいことを文章で（出来れば実例も挙げて）
（B)参考までに自分の考えたコード
と整理すること。
以下に見本を挙げてみる。思考の整理状態を反映するはず。
（概略）
２００個ぐらいのエクセルブックがある。ファイルは１つのフォルダの中にある。
その決まったセルを、１つのブック（且つ１つのシートに）集約したい。
集落されるデータは、集約されるブックの第１シートにある。
（詳細）
集約するブックはdbase.xlsのSheets(1)
集約されるそれは Workbooks("001.xls").Worksheets(1)
--
セル関係は
仮にiというカウンターを考え、最初は２（第２行）から
A列＜－－R3
B列＜－－C2
C列＜－－R2　　右辺はこのようにに決まっている
１ブック処理終ると、ブックをクローズし、i=i+1とポインタを進める。次のブックを開く。
＝＝＝＝
問題は
●仮にiというカウンターを考える（データをセットする、変動する行を受け持つ変数）。１ブック処理が終ると＋１
●＞ActiveCell.Offset(, 1).Select
こんなコードは普通記述しない。間違いではないが。
以上が気がついた点です。
全ファイル（ブック）を捉えるのは
FSOでFor Eachで繰り回す例も多い。
http://officetanaka.net/excel/vba/filesystemobject/sample.htm
の０７など参照。WEBで他多数実例あり。

お礼

説明がうまくできなくてわかりにくく申し訳ありません。
今日初めてＶＢＥを使ってみたもので、本に書いてあることしか応用できず、普通記述しないとは知りませんでした。
参考サイトをありがとうございます。
勉強してみます。

回答No.1

-yellowtail-

Dim fn as String, i as Integer
Dim Mydir as String

　　Mydir = ThisWorkbook.Path
　　ChDir Mydir
　　fn = Dir(Mydir & "\*.xls")
　　if fn="" then Exit Sub　'***** 入れなくてもいい文
　　i = 2
　　Do
　　　　If fn <> Thisworkbook.Name Then
　　　　　　'***** ここに処理を記入
　　　　　　myFLName = Mydir & "\" & fn & ".xls"
　　　　　　Workbooks.Open Filename:=myFLName, ReadOnly:=True
　　　　　　Workbooks("dbase.xls").Cells(i, 1)= i
　　　　　　Workbooks("dbase.xls").Cells(i, 2)= Workbooks(fn).Sheets(1).Range("R3")
　　　　　　Workbooks("dbase.xls").Cells(i, 3)= Workbooks(fn).Sheets(1).Range("C2")
　　　　　　Workbooks("dbase.xls").Cells(i, 4)= Workbooks(fn).Sheets(1).Range("R2")

　　　　　　fn = Dir()　　'***** 次のファイル名を取得します
　　　　End if
　　　　i=i+1
　　Loop Until fn = ""

これで、Mydir内のすべてのファイルをひとつづつ処理します。
変数fnにはファイルの名前が入るので…
myFLName = Mydir & "\" & fn & ".xls"
となるわけです★
Cells(i,1)は、Cells(y座標,x座標)になるので、最初のブックは2行目、次は3行目…というようになります。
Cells(i,1)　は　Range("A2")　です。（i=2のとき）

このように変数はDo～Loopで回すといいと思います。
行数は単純に増えるのでインクリメントでＯＫかと思います。
ただ、番号の小さい順にファイルを取得したりはしないですが、それは大丈夫ですか？

お礼

スマートに書いてくださいまして、ありがとうございます！　
私には本を見ながらしか書けないので、とても感激です。m(_ _)m

書いていただいたコードをステップインで実行していくと、次の場所で、

　　　　　　Workbooks("dbase.xls").Cells(i, 1)= i

実行時エラー　'438':
オブジェクトは、このプロパティまたはメソッドをサポートしていません。

と出るのですが、どうしたらよいか教えていただけますか。