• ベストアンサー

複数のcsvファイルを1つのEXCELファイルにマージするVBAを教えてください

csvファイル数は700~1000個程度でひとつのフォルダに格納されています。 このファイルをEXCEL形式で開くと、1行目にフィールド名(A~Z列で固定)、2行目以降にデータが入っています。行数はファイルにより1~100行程度で変動します。 このファイルを1つのエクセルファイルの同一シートに結合(マージ)するVBAがほしいです。 ここで、(できればですが)EXCELにマージするにあたり、1行目のみフィールドの値、2行目以降にそれぞれのcsvの2行目以降データの値を入れていくようにしたいです。つまり、フィールド名の行が何行も出てくるのを避けたいです。 申し訳ございませんが、ご指導いただけたら幸いです。よろしくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • end-u
  • ベストアンサー率79% (496/625)
回答No.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

japan116
質問者

お礼

end-uさん ありがとうございます!まさにこんなツールがほしいと思ってました!しかもA列にファイル名が追加されるのは、データの出所がわかるのでさらに便利ですね!早速活用させていただきます! 本当にありがとうございました。 これにて質問を締め切らせていただきます。

すると、全ての回答が全文表示されます。

その他の回答 (1)

  • fujillin
  • ベストアンサー率61% (1594/2576)
回答No.1

自動化するなら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 各データ(セルに記入するデータ)内にカンマ(,)を含んでいる可能性がある場合は、その処理がちょいと面倒かも。

japan116
質問者

お礼

fujillinさん ありがとうございます!ご紹介いただいたもわかりやすいですね。これを一人で作れるかは不安ですが、参考にさせていただきます! > 基本的な考え方としては、csvをテキストファイルで1行ずつ読み込み、2> 行目以降をシートにコピーしてゆくということになるのかな? > (もちろん最初のファイルのみ、1行目も処理する) おっしゃる通りです。 トータルのデータでEXCELの行数で何とか間に合いそうですが、やはり大きなデータになるので処理速度を考えると、ACCESSなどに一度インポートして、そのデータをEXCELで加工したほうが良さそうですかね。。

すると、全ての回答が全文表示されます。

関連するQ&A

専門家に質問してみよう