大量のＣＳＶデータを１つのエクセルデータにまとめる方法について

質問

今仕事で、ＣＳＶファイルが４００ファイル程あり、これを一つの
エクセルファイルにまとめなくて加工しなければならないのですが
うまいことＶＢＡを活用して効率的にできないか思案中なのですが
うまい具合に行きません。
データの持ち方として
○ＣＳＶファイル１
１．ＡＡＡ
２．ＢＢＢ

○ＣＳＶファイル２
３．ＣＣＣ
４．ＤＤＤ

となっており、これを１つのエクセルファイル上で
１．ＡＡＡ
２．ＢＢＢ
３．ＣＣＣ
４．ＤＤＤ
としたいのですがなにかいい方法はないでしょうか？
１つのブックで外部データの取り込みでＣＳＶを次々に選択して
いくＶＢＡなんてあれば教えていただけないでしょうか？
よろしくお願いします。

回答No.1

pauNed · ベストアンサー

こんにちは。
昔書いた事があるサンプルです。
同一フォルダにあるcsvファイルをまとめて処理します。

Sub CSVまとめsample()
　　Dim MyObj As Object
　　Dim MyFol As String
　　Dim MyFnm As String
　　Dim MyStr As String
　　Dim i　　 As Long
　　Dim n　　 As Long
　　Dim n1　　As Long

　　'フォルダを選択する
　　Set MyObj = CreateObject("Shell.Application") _
　　　　.BrowseForFolder(0, "SelectFolder", 0)
　　'選択なければ処理を抜ける
　　If MyObj Is Nothing Then Exit Sub
　　MyFol = MyObj.self.Path & "\"
　　MsgBox MyFol & "を処理します。"
　　Set MyObj = Nothing
　　Application.ScreenUpdating = False
　　'ThisWorkbookにシートを追加して処理
　　With Sheets.Add
　　　　'Dir関数を使って指定フォルダ内csvファイルを順次処理
　　　　MyFnm = Dir(MyFol & "*.csv")
　　　　Do Until Len(MyFnm) = 0&
　　　　　　i = i + 1
　　　　　　'データエリアを取得してセット先を変更
　　　　　　n = IIf(n = 0, 1, n + n1)
　　　　　　'外部データ取り込みを利用
　　　　　　With .QueryTables.Add(Connection:="TEXT;" & MyFol & MyFnm, _
　　　　　　　　　　　　　　　　　Destination:=.Range("B" & n))
　　　　　　　　.AdjustColumnWidth = False
　　　　　　　　.TextFilePlatform = xlWindows
　　　　　　　　.TextFileStartRow = 1
　　　　　　　　.TextFileCommaDelimiter = True
　　　　　　　　.Refresh False
　　　　　　　　n1 = .ResultRange.Rows.Count
　　　　　　　　.Parent.Names(.Name).Delete
　　　　　　　　.Delete
　　　　　　End With
　　　　　　'ファイル名をA列にセット
　　　　　　.Range("A" & n).Resize(n1).Value = MyFnm
　　　　　　'次のファイルへ
　　　　　　MyFnm = Dir()
　　　　Loop
　　End With
　　If i > 0 Then
　　　　MyStr = i & "個のファイルを処理しました。"
　　Else
　　　　'検索結果が０なら
　　　　MyStr = "検索条件を満たすファイルはありません。"
　　End If
　　Application.ScreenUpdating = True
　　MsgBox MyStr
End Sub

#シート行数をオーバーした時のエラー処理などはしてないので
#うまくいかなかったらごめんね^ ^;

お礼

教えていただきましたサンプルを使わせていただいた結果うまく
すべてのファイルを処理することができ、お蔭様でひたすら作業
をしなくて済みました。
どうもありがとうございました。

回答No.3

pauNed

#1の蛇足の補足ですが、Excelでのcsvファイル読み込みは結構重い処理です。
http://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200703/07030115.txt
[外部データ取り込み]は比較的速いですが、
複数ファイル処理時は、Table定義や名前定義の削除などに気をつけなければなりません。
コーディングの手間を考えると、cmd.exeを使うのも一つの方法です。

windowsメニューから[ファイル名を指定して実行]
コマンドプロンプトに
copy /b d:\test\*.csv d:\ketugou.csv
と入力して[Enter]

Dドライブのtestフォルダの拡張子csvファイルを、 Dドライブ直下のketugou.csvとしてまとめて
バイナリモードでコピー...というコマンドです。
これで１つにまとめたファイルをExcelに読み込めば良いかと。

VBAで実行するなら

Sub CSV結合()
　　Const CRFILE As String = "D:\ketugou.csv"
　　Dim obj As Object
　　Dim arg As String

　　Set obj = CreateObject("Shell.Application") _
　　　　.BrowseForFolder(0, "SelectFolder", 0)
　　If obj Is Nothing Then Exit Sub
　　arg = obj.self.Path & "\*.csv "
　　Set obj = Nothing
　　Call Shell(Environ("ComSpec") & " /c copy /b " & arg & CRFILE)
End Sub
（Excelに読み込む前のまとめるところまでです）
参考まで。

回答No.2

imogasi

ＣＳＶファイルの数が多いだけで、問題自体平凡な内容で、ＷＥＢや本に類似例が載っています。
（１）拡張子だＣＳＶファイルに統一だれているか
でない場合、手作業で統一できるか。
（２）ＣＳＶファイルは１つのフォルダの中にまとまっているか。
２，３までなら同じことの繰り返しで対処できるでしょうが。
（３）ＣＳＶファイルは１つのフォルダの中にまとまっているとして、そのフォルダには他のファイル形式のファイルが混在するか
（４）最悪の場合、ＣＳＶファイルの名前のリストがエクセルの例えばＡ列の４００行に作れるか。
ーー
（１）（２）（３）が都合よい状態として
（Ａ）ＶＢのＤｉｒ関数の利用（既回答）
（Ｂ）ＶＢｓｃりｐｔ的に処理
ーーー
Sub test02()
Set objFS = CreateObject("Scripting.FileSystemObject")
' フォルダーの名称を取り出す
strFDIRNAME = CurDir
' GetFolderで、フォルダーオブジェクトを取得します
Set objdir = objFS.GetFolder(strFDIRNAME)
MsgBox objdir
' Filesコレクションにアクセスする
For Each objFILE In objdir.Files
strFname = objFILE.Name '取り出したobjFILEの.Nameを取得
If Right(strFname, 4) = ".csv" Then '.csvなら処理
MsgBox strFname
'処理
Else
End If
Next
End Sub
処理の方法として
（Ｘ）Ｏｐｅｎ　Ｉｎｐｕｔ方式
（Ｙ）ＶＢＳｃｒｉｐｔ式のＯｐｅｎてｘｔＦｉｌｅ
が缶上げられる（下記）
ーーー
Sub test02()
Set objFS = CreateObject("Scripting.FileSystemObject")
' フォルダーの名称を取り出す
strfdirname = CurDir
' GetFolderで、フォルダーオブジェクトを取得します
Set objdir = objFS.GetFolder(strfdirname)
MsgBox objdir
' Filesコレクションにアクセスする
For Each objFILE In objdir.Files
strfname = objFILE.Name '取り出したobjFILEの.Nameを取得
If Right(strfname, 4) = ".csv" Then '.csvなら処理
MsgBox strfname
'処理
MsgBox strfdirname & "\" & strfname
Set objTS = objFS.OpenTextFile(strfdirname & "\" & strfname)
While objTS.AtEndOfStream = False
mytext = objTS.readline
MsgBox mytext
'各行処理
'Split関数で、カンマで分離
'エクセルへの取り込み処理
Wend
Else
End If
Next
End Sub
ーーー
'エクセルへの取り込み処理については、
http://ncdomino.notescons.gr.jp/ncDisc.nsf/1e288666e0dc26cb49256bfd000bf211/C0F99BEC9E1F72A749257272001AC038?OpenDocument
他多数あり参照。
検索キーワード　Createobject excelapplication

お礼

ＣＳＶファイルは全て統一されたファイルでしたので
手作業等は発生せず対応できました。
どうもありがとうございました！