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

解決済みの質問

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

こんにちは。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ブックから1レコードになるようにしたいと
思います。

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

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

投稿日時 - 2008-04-24 12:09:21

QNo.3972230

困ってます

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

#4 の補足

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

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

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

となります。

投稿日時 - 2008-04-24 19:52:03

お礼

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

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

投稿日時 - 2008-04-27 18:37:15

ANo.5

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

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

回答(5)

ANo.4

こんばんは。

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


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

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

投稿日時 - 2008-04-24 19:19:01

お礼

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

投稿日時 - 2008-04-26 10:45:15

ANo.3

#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 ←オブジェクトならこう!簡単になります☆

投稿日時 - 2008-04-24 19:04:19

お礼

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

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

投稿日時 - 2008-04-26 10:04:02

ANo.2

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

投稿日時 - 2008-04-24 16:53:45

お礼

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

投稿日時 - 2008-04-24 18:02:53

ANo.1

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で回すといいと思います。
行数は単純に増えるのでインクリメントでOKかと思います。
ただ、番号の小さい順にファイルを取得したりはしないですが、それは大丈夫ですか?

投稿日時 - 2008-04-24 16:19:01

お礼

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

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

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

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

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

投稿日時 - 2008-04-24 18:07:15

あなたにオススメの質問