プロが教えるわが家の防犯対策術!

今仕事で、CSVファイルが400ファイル程あり、これを一つの
エクセルファイルにまとめなくて加工しなければならないのですが
うまいことVBAを活用して効率的にできないか思案中なのですが
うまい具合に行きません。
データの持ち方として
○CSVファイル1
1.AAA
2.BBB

○CSVファイル2
3.CCC
4.DDD

となっており、これを1つのエクセルファイル上で
1.AAA
2.BBB
3.CCC
4.DDD
としたいのですがなにかいい方法はないでしょうか?
1つのブックで外部データの取り込みでCSVを次々に選択して
いくVBAなんてあれば教えていただけないでしょうか?
よろしくお願いします。

A 回答 (3件)

こんにちは。


昔書いた事があるサンプルです。
同一フォルダにある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
    '検索結果が0なら
    MyStr = "検索条件を満たすファイルはありません。"
  End If
  Application.ScreenUpdating = True
  MsgBox MyStr
End Sub

#シート行数をオーバーした時のエラー処理などはしてないので
#うまくいかなかったらごめんね^ ^;
    • good
    • 5
この回答へのお礼

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

お礼日時:2007/07/16 00:51

#1の蛇足の補足ですが、Excelでのcsvファイル読み込みは結構重い処理です。


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

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

Dドライブのtestフォルダの拡張子csvファイルを、 Dドライブ直下のketugou.csvとしてまとめて
バイナリモードでコピー...というコマンドです。
これで1つにまとめたファイルを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に読み込む前のまとめるところまでです)
参考まで。
    • good
    • 8

CSVファイルの数が多いだけで、問題自体平凡な内容で、WEBや本に類似例が載っています。


(1)拡張子だCSVファイルに統一だれているか
でない場合、手作業で統一できるか。
(2)CSVファイルは1つのフォルダの中にまとまっているか。
2,3までなら同じことの繰り返しで対処できるでしょうが。
(3)CSVファイルは1つのフォルダの中にまとまっているとして、そのフォルダには他のファイル形式のファイルが混在するか
(4)最悪の場合、CSVファイルの名前のリストがエクセルの例えばA列の400行に作れるか。
ーー
(1)(2)(3)が都合よい状態として
(A)VBのDir関数の利用(既回答)
(B)VBscりpt的に処理
ーーー
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
処理の方法として
(X)Open Input方式
(Y)VBScript式のOpenてxtFile
が缶上げられる(下記)
ーーー
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/1e288 …
他多数あり参照。
検索キーワード Createobject excelapplication
    • good
    • 1
この回答へのお礼

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

お礼日時:2007/07/16 00:52

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています