• ベストアンサー

EXCEL VBAでワークブックのデータ取得

コードを実行するブックがあるホルダー内の全てのブック(10個程度)からSheet1のA列~E列のデータ(行数はブックにより異なりますが大体2000行程度)の2行目以降を取得し、コードを実行するブックのSheet("DATA")の2行目以降にデータを貼り付け、F列に取得したブック名を記載したいのです。 残念ながら最初でつまずいています。 なにとぞご教示お願いします。

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

  • ベストアンサー
  • matsu_jun
  • ベストアンサー率55% (146/265)
回答No.3

$および#は、変数の定義をする時の省略した書き方で、型宣言文字と呼びます。 fldPath$ = ThisWorkbook.Path & "\" はつまり、 Dim fldPath As String fldPath = ThisWorkbook.Path & "\" という2文をまとめたものになります。 蛇足ですが、書き換えた文の1行目は 「文字列を格納する(String型の)変数"fldPath"を定義します」という意味です。 #、$のほかにも色々な型について型宣言文字がありますので下記URLをご参考ください。

参考URL:
http://t_shun.at.infoseek.co.jp/My_Page/Excel-VBA/vba_page4.htm
merlionXX
質問者

お礼

すみません。 なんどもありがとうございました。 これからもよろしくご指導ください。

その他の回答 (2)

  • matsu_jun
  • ベストアンサー率55% (146/265)
回答No.2

コードを実行するブックと他のブックのフォルダを分ければエラーはでませんが、確かに質問の最初に > コードを実行するブックがあるホルダー内 と書いてありますね。というわけで、  1) 同一フォルダから自分自身以外について実行  2) ブック名は各行の後ろに記載 というように改造しました。フォルダ選択のウィンドウも表示しないようにしました。少しコードが簡単になったと思いますので、動作の詳細も一度ご自身でご確認ください。 Sub Test() fldPath$ = ThisWorkbook.Path & "\" filname$ = Dir(fldPath & "*.xls") '選択したフォルダ内のExcelファイルを検索します inputline# = 2 'データ挿入行の初期値を2行目からとしています Do Until filname = Empty '全て検索し終えると、filename = Empty となるので、その間以下を実行します If filname <> ThisWorkbook.Name Then Workbooks.Open fldPath & filname '選択したファイルを開きます For i# = 2 To ActiveWorkbook.Worksheets("Sheet1").Cells(65535, 1).End(xlUp).Row '2行目から最終行まで以下を実行します For j# = 1 To 5 'A列からE列まで以下を実行します ThisWorkbook.Worksheets("DATA").Cells(inputline, j). _ Value = ActiveWorkbook.Worksheets("Sheet1").Cells(i, j).Value Next j ThisWorkbook.Worksheets("DATA").Cells(inputline, 6).Value = filname inputline = inputline + 1 Next i ActiveWorkbook.Close End If filname = Dir '選択したフォルダ内の次のExcelファイルを検索します Loop End Sub

merlionXX
質問者

お礼

ありがとうございました。 完璧です! これで来週からの作業がとても早くできるようになります。 大変感謝いたしております。

merlionXX
質問者

補足

これで締め切りたいと思いますが、勉強のためにもう一つだけ教えてください。 変数の fldPath$ inputline# の$と#はどのような意味でしょうか?

  • matsu_jun
  • ベストアンサー率55% (146/265)
回答No.1

少し不明な点があります。 1) 全てのブックのデータを貼り付けるということですが、例えばブックAのデータをまず貼り付けた後、ブックBのデータはどこに貼り付けるのでしょうか 2) ブック名はF列の何行目に記載すればよいのでしょうか とりあえず以下に記載したマクロは 1) まず一つ目のブックのデータを貼り付けた後、その下の行から2番目のブックのデータを貼り付けるようにしています。(この際、A列からE列までは同じ行までデータが記載していると仮定し、A列の最下行までを貼り付ける仕様にしています) 2) ブック名は1行目から順番に記載しています。 ソースにコメントを残しておきますので、上の仮定が間違っていたら、問題の場所の記述を変更してください。 'ここから---------------------------------------------------------------------------------------- Sub Test() Dim fldobj As Object Dim fldPath As String 'フォルダを選択します Set fldobj = CreateObject("Shell.Application").BrowseForFolder(0, "フォルダの選択", 0, "c:\\") If Not fldobj Is Nothing Then '上でフォルダが選択されれば以下を実行します fldPath = fldobj.Items.Item.Path & "\" '選択したフォルダのパスを取得します filname$ = Dir(fldPath & "*.xls") '選択したフォルダ内のExcelファイルを検索します inputline# = 2 'データ挿入行の初期値を2行目からとしています filnameline# = 2 'ブック名挿入行の初期値を2行目からとしています Do Until filname = Empty '全て検索し終えると、filename = Empty となるので、その間以下を実行します Workbooks.Open fldPath & filname '選択したファイルを開きます For i# = 2 To ActiveWorkbook.Worksheets("Sheet1").Cells(65535, 1).End(xlUp).Row '2行目から最終行まで以下を実行します For j# = 1 To 5 'A列からE列まで以下を実行します ThisWorkbook.Worksheets("DATA").Cells(inputline, j). _ Value = ActiveWorkbook.Worksheets("Sheet1").Cells(i, j).Value Next j inputline = inputline + 1 Next i ThisWorkbook.Worksheets("DATA").Cells(filnameline, 6).Value = filname 'F列にブック名を記載します。 filnameline = filnameline + 1 ActiveWorkbook.Close filname = Dir '選択したフォルダ内の次のExcelファイルを検索します Loop End If End Sub 'ここまで----------------------------------------------------------------------------------------

merlionXX
質問者

補足

ありがとうございます。 書き方が悪かったので補足いたします。 1)の仮定はその通りです。 2)は貼り付けたデータのある全ての行のF列にずらずら~っと表示したいのです。 あとは、上記コードを実行すると、コードを書いたブック本体をも開こうとしてエラーが出ます。 コードを実行するブックはすでに開かれているので、これを開く指示はでないようにできませんか? よろしくお願いします。

関連するQ&A

専門家に質問してみよう