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

質問

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

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

回答No.3

kigoshi · ベストアンサー

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

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

お礼

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

回答No.2

kigoshi

> ダイアログボックスで複数の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

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

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

お礼

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

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