- ベストアンサー
複数のcsvファイルを1つのEXCELファイルにマージするVBAを教えてください
csvファイル数は700~1000個程度でひとつのフォルダに格納されています。 このファイルをEXCEL形式で開くと、1行目にフィールド名(A~Z列で固定)、2行目以降にデータが入っています。行数はファイルにより1~100行程度で変動します。 このファイルを1つのエクセルファイルの同一シートに結合(マージ)するVBAがほしいです。 ここで、(できればですが)EXCELにマージするにあたり、1行目のみフィールドの値、2行目以降にそれぞれのcsvの2行目以降データの値を入れていくようにしたいです。つまり、フィールド名の行が何行も出てくるのを避けたいです。 申し訳ございませんが、ご指導いただけたら幸いです。よろしくお願いします。
- みんなの回答 (2)
- 専門家の回答
質問者が選んだベストアンサー
しばらく前に書いた事があるコードです。 参考になるようだったら応用してみてください。 '--------------------------------------------------------------------- Private Sub try() Dim ws As Worksheet Dim fd As String Dim fn As String Dim ret As String Dim i As Long Dim n As Long Dim x As Long Dim s As Long fd = ThisWorkbook.Path & "\" 'fd = FDSELECT 'フォルダ選択の場合 If Len(fd) = 0& Then Exit Sub Application.ScreenUpdating = False 'ActiveWorkbookにシートを追加して処理 Set ws = Sheets.Add On Error GoTo errHndler fn = Dir(fd & "*.csv") x = 1 s = 1 Do Until Len(fn) = 0& i = i + 1 'データCountにより次のセット先変更 n = n + x '外部データ取り込み x = CSVQRY(ws, fd & fn, ws.Cells(n, 2), s) If x < 0 Then Err.Raise Number:=1000, Description:="CSV読み込みに失敗" ElseIf (n + x) >= Rows.Count Then '行数overしてもエラーかからないため取り込み直し ws.Rows(n).Resize(x).Delete Set ws = Sheets.Add n = 1 x = CSVQRY(ws, fd & fn, ws.Cells(n, 2), 1&) End If 'ファイル名をA列にセット ws.Cells(n, 1).Resize(x).Value = fn s = 2 fn = Dir() Loop If i > 0 Then ret = i & "files.done" Else ret = "no file" End If errHndler: If Err.Number <> 0 Then ret = Err.Number & vbTab & Err.Description Debug.Print ret End If Application.ScreenUpdating = True MsgBox ret Set ws = Nothing End Sub '--------------------------------------------------------------------- Private Function CSVQRY(ByRef ws As Worksheet, _ ByRef fs As String, _ ByRef rs As Range, _ ByVal sr As Long) As Long Dim cnt As Long On Error GoTo errChk With ws.QueryTables.Add(Connection:="TEXT;" & fs, _ Destination:=rs) .AdjustColumnWidth = False .TextFilePlatform = xlWindows .TextFileStartRow = sr .TextFileCommaDelimiter = True .Refresh False cnt = .ResultRange.Rows.Count .Parent.Names(.Name).Delete .Delete End With CSVQRY = cnt Exit Function errChk: CSVQRY = -1 End Function '--------------------------------------------------------------------- Private Function FDSELECT() As String 'フォルダ選択Function Dim obj As Object Dim ret As String Set obj = CreateObject("Shell.Application") _ .BrowseForFolder(0, "SelectFolder", 0) If obj Is Nothing Then Exit Function On Error Resume Next ret = obj.self.Path & "\" If Err.Number <> 0 Then ret = obj.Items.Item.Path & "\" Err.Clear End If On Error GoTo 0 Set obj = Nothing FDSELECT = ret End Function
その他の回答 (1)
- fujillin
- ベストアンサー率61% (1594/2576)
自動化するならVBAを利用することになるでしょう。 基本的な考え方としては、csvをテキストファイルで1行ずつ読み込み、2行目以降をシートにコピーしてゆくということになるのかな? (もちろん最初のファイルのみ、1行目も処理する) 処理が1行単位なので、カンマの処理さえできれば、あとはなんとかなるでしょう。 ただし、ファイル数1000、データの行数100とすると最大で100,000行くらいになるかも知れないので、1シートには納まらない可能性があります。 記入対象の行を監視して、シートの最大行を超えるなら、新しいシートに記入するなどの制御をしておいたほうがよさそうですね。 以下を組み合わせれば、概ねのところはできるかと。 1)フォルダ内の各ファイルを処理する方法は以下を参照 http://homepage2.nifty.com/kasayan/vba/dir.htm 2)ファイルの読込み(テキストファイル)の基本はこちら http://officetanaka.net/excel/vba/file/file08.htm 3)csvの読み込みについてはこちら http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_020.html 各データ(セルに記入するデータ)内にカンマ(,)を含んでいる可能性がある場合は、その処理がちょいと面倒かも。
お礼
fujillinさん ありがとうございます!ご紹介いただいたもわかりやすいですね。これを一人で作れるかは不安ですが、参考にさせていただきます! > 基本的な考え方としては、csvをテキストファイルで1行ずつ読み込み、2> 行目以降をシートにコピーしてゆくということになるのかな? > (もちろん最初のファイルのみ、1行目も処理する) おっしゃる通りです。 トータルのデータでEXCELの行数で何とか間に合いそうですが、やはり大きなデータになるので処理速度を考えると、ACCESSなどに一度インポートして、そのデータをEXCELで加工したほうが良さそうですかね。。
お礼
end-uさん ありがとうございます!まさにこんなツールがほしいと思ってました!しかもA列にファイル名が追加されるのは、データの出所がわかるのでさらに便利ですね!早速活用させていただきます! 本当にありがとうございました。 これにて質問を締め切らせていただきます。