同じ形のCSVファイルを複数同時に外部データの取り込み出来るマクロ

ダイアログボックスで複数のCSVファイルを選択して、1つのシートに上から順番につめて取り込みが出来るマクロは作れるでしょうか？

形が同じというのは1行目の項目が同じという意味です。

No.3 ベストアンサー 回答者： kigoshi 回答日時： 2006/07/12 17:18

No.1さんが示してくれた参考ページの「■複数のファイルを選択可能にする」を見ればやりかたは分かるかと思います。

Sub putCsv()
Dim csvFile As Variant
Dim fIdx As Integer
Dim dCell As String
csvFile = Application.GetOpenFilename(FileFilter:="ＣＳＶファイル,*.csv", MultiSelect:=True)
If Range("A65536").End(xlUp).Row = 1 Then
dCell = "A1"
Else
dCell = "A" & CStr(Range("A65536").End(xlUp).Row + 1)
End If
For fIdx = 1 To UBound(csvFile)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & csvFile(fIdx), Destination:=Range(dCell))
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
End With
dCell = "A" & CStr(Range("A65536").End(xlUp).Row + 1)
Next
End Sub

これで、ほぼ完成形かと思いますが、いかがでしょう。

この回答へのお礼

まとめてお礼を書かせていただきます。ありがとうございました。がんばってみます

お礼日時：2006/07/26 22:47

No.2 回答者： kigoshi 回答日時： 2006/07/11 09:26

> ダイアログボックスで複数のCSVファイルを選択して、

の部分についてはNo1.さんのご回答がありますので、
> 1つのシートに上から順番につめて取り込みが出来るマクロは作れるでしょうか？
の部分の回答例を作ってみました。

Sub getCsv()
Dim csvFile(2)
Dim fIdx As Integer
Dim dCell As String

csvFile(0) = "c:\a.csv"
csvFile(1) = "c:\b.csv"
csvFile(2) = "c:\c.csv"

dCell = "A1"
For fIdx = 0 To 2
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & csvFile(fIdx), Destination:=Range(dCell))
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
End With
dCell = "A" & CStr(Range("A65536").End(xlUp).Row + 1)
Next
End Sub

ご参考になれば。

No.1 回答者： popesyu 回答日時： 2006/07/10 20:40

もちろん可能です。

やり方は色々ありますが、多分「GetOpenFilename」が一番ご希望のものに近いんじゃないかと。
http://www.officetanaka.net/excel/vba/file/file0 …

あとは複数回分取り込み処理をループするだけになります。が質問内容からして、その取り込み処理の部分を一番聞きたいのでしょうかね？？

この回答へのお礼

お礼が遅くなってすいません。回答ありがとうございます。
それで、popesyuさんの文の最後の
＞取り込み処理の部分
そのもののマクロがわかりません。

それと、
＞複数回分取り込み処理をループするだけになります。
というのはダイアログボックスでCSVファイルを複数個選択して、1度に上から詰めて出力されるのか、1個ずつダイアログボックスから出力して、回数分ダイアログボックスを開くことになるんでしょうか？

お礼日時：2006/07/12 11:25