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

質問

コードを実行するブックがあるホルダー内の全てのブック（10個程度）からSheet1のA列～E列のデータ（行数はブックにより異なりますが大体2000行程度）の2行目以降を取得し、コードを実行するブックのSheet("DATA")の2行目以降にデータを貼り付け、F列に取得したブック名を記載したいのです。

残念ながら最初でつまずいています。
なにとぞご教示お願いします。

回答No.3

matsu_jun · ベストアンサー

$および#は、変数の定義をする時の省略した書き方で、型宣言文字と呼びます。

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

お礼

すみません。
なんどもありがとうございました。

これからもよろしくご指導ください。

回答No.2

matsu_jun

コードを実行するブックと他のブックのフォルダを分ければエラーはでませんが、確かに質問の最初に
> コードを実行するブックがあるホルダー内
と書いてありますね。というわけで、
　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

お礼

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

完璧です！
これで来週からの作業がとても早くできるようになります。

大変感謝いたしております。

補足

これで締め切りたいと思いますが、勉強のためにもう一つだけ教えてください。

変数の
fldPath$
inputline#

の＄と＃はどのような意味でしょうか？

回答No.1

matsu_jun

少し不明な点があります。
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

'ここまで----------------------------------------------------------------------------------------

補足

ありがとうございます。
書き方が悪かったので補足いたします。

1）の仮定はその通りです。
2）は貼り付けたデータのある全ての行のF列にずらずら～っと表示したいのです。

あとは、上記コードを実行すると、コードを書いたブック本体をも開こうとしてエラーが出ます。
コードを実行するブックはすでに開かれているので、これを開く指示はでないようにできませんか？

よろしくお願いします。