マクロを使用してCSVファイルの結合を行いたいのですが・・・

質問

エクセル2000を使用している初級者です。過去の質問の中から、素晴らしい結合のマクロを見つ

けました。同一フォルダ内にあるファイルは見事に結合されました。ただ私が結合したいものは、

１時間で１ファイル、１日で１フォルダが作られており、フォルダが31個有ります。手作業で31個の

フォルダをまとめるのも辛いので、１月分をまとめて結合するために、マクロの冒頭部分を私なり

に色々手は加えてみたのですが、悲しいかな動きません。以下にコピーしますので、よろしくお願

い致します。又明日より出張のため、お礼が遅くなると思います。ご容赦下さい。

Sub Test()
Dim Files, FilesCnt As Integer, i As Integer
Dim cBook As Workbook, pBook As Workbook

Files = Application.GetOpenFilename _
(FileFilter:="CsVFile(*.csv), *.csv", MultiSelect:=True)
If IsArray(Files) Then
Set pBook = Workbooks.Add(xlWBATWorksheet)
FilesCnt = UBound(Files)
For i = 1 To FilesCnt
Workbooks.Open Files(i)
Set cBook = ActiveWorkbook
cBook.ActiveSheet.UsedRange.Copy
With pBook.ActiveSheet
.Cells(.Range("A65536").End(xlUp).Row, 1). _
PasteSpecial (xlPasteAll)
End With
Application.CutCopyMode = False
cBook.Close
Next i
End If
Set cBook = Nothing: Set pBook = Nothing
End Sub

回答No.1

papayuka · ベストアンサー

元のコードは一部問題があると思います。
このコードでは最後の1行を上書きしてしまいます。
私の書き方に似ているので、ひょっとして私が書いたものかもしれませんが、、、(^-^)

フォルダとデータの構成が解かりませんので外しているかも知れません。
サンプルはマクロがあるExcelファイルと同じフォルダ内（子フォルダ内も含めて）にあるCSVファイルを全て開いて新規ブックにまとめます。

'********************************************************************
Sub Test1()
Dim files As FileSearch, FilesCnt As Integer, i As Integer
Dim cBook As Workbook, pBook As Workbook

　FilesCnt = mySearch(files, ThisWorkbook.Path)
　If FilesCnt = 0 Then Exit Sub
　Set pBook = Workbooks.Add(xlWBATWorksheet)
　　For i = 1 To FilesCnt
　　　Workbooks.Open files.FoundFiles(i)
　　　Set cBook = ActiveWorkbook
　　　cBook.ActiveSheet.UsedRange.Copy
　　　With pBook.ActiveSheet
　　　　If i > 1 Then
　　　　　.Cells(.Range("A65536").End(xlUp).Row + 1, 1). _
　　　　　 PasteSpecial (xlPasteAll)
　　　　Else
　　　　　.Cells(.Range("A65536").End(xlUp).Row, 1). _
　　　　　 PasteSpecial (xlPasteAll)
　　　　End If
　　　End With
　　　Application.CutCopyMode = False
　　　cBook.Close
　　Next i
　Set cBook = Nothing: Set pBook = Nothing
End Sub

'********************************************************************
Function mySearch(files As FileSearch, myDir As String) As Integer
　mySearch = 0
　Set files = Application.FileSearch
　With files
　　　.NewSearch
　　　.LookIn = myDir
　　　.SearchSubFolders = True
　　　.Filename = "*.csv"
　　　If .Execute() > 0 Then mySearch = .FoundFiles.Count
　End With
End Function
'********************************************************************

お礼

早々のお答えありがとうございます。

確かにこのコードはNO.1様の書かれたものです。

重ね重ね感謝です。シートに写真が自動で張り付いて

いく様を見て感激、VBAを勉強しようと、本も５冊ほど

購入したのですが、記述が少し違うだけで

手も足も出ない状態です。簡単でないのは判っていま

すが・・・スクールに通った方がよいのでしょうね。

補足

肝心なことを書き忘れておりました。

もちろん動作はパーフェクトでした。

ありがとうございました。

回答No.3

imogasi

CSVファイルを結合(多分集約。１つのファイルにまとめる）するのに、エクセルに読みこんでコピーして貼り付ける必要はありません。その線の回答も載るかもしれませんが。
あるフォルダに有るCSVファイルの項目と数は勿論同じとします。
あるフォルダ内のCSVファイルの名をまず掴まえます。
エクセルのシートに表示します。
Private Sub test01()
Dim fn As String
Dim hn As String
p01:
fn = InputBox("フォルダ名=", "フォルダ指定", "c:\My Documents\")
If fn = "end" Then Exit Sub
' fn = "c:\My Documents\"
i = 2
sdirname = Dir(fn)
Do While sdirname <> ""
If Right(sdirname, 4) = ".csv" Then
Cells(i, 1) = sdirname
hn = fn & sdirname
Cells(i, 2) = hn
i = i + 1
End If
'------
sdirname = Dir
Loop
GoTo p01
End Sub
これでSheet1にCSVファイル名がリストされます。フォルダを聞いてきたとき、例えばCドライブのaa21.csvフォルダを対象にするなら、C:\aa21.csv\と最後に￥を付けて答えてください。
集約するフォルダ名の最後の次は（終わりは）、「end」（半角）を答えて（入力して）ください。
それでエクセルのシートを見て、ブック名のリストアップは完全かチェックしてください。
完全なら
Private Sub test01()
Dim fn As String
Dim hn As String
Open "c:\my documents\aa23.csv" For Output As #2
p01:
fn = InputBox("フォルダ名=", "フォルダ指定", "c:\My Documents\")
If fn = "end" Then Exit Sub
' fn = "c:\My Documents\"
i = 2
sdirname = Dir(fn)
Do While sdirname <> ""
If Right(sdirname, 4) = ".csv" Then
hn = fn & sdirname
Open hn For Input As #1
While Not EOF(1)
Line Input #1, a
Print #2, a
Cells(i, 1) = a
i = i + 1
Wend
Close #1
End If
'------
sdirname = Dir
Loop
GoTo p01
End Sub
にコードを変えて、実行しエクセルのシートのA列に正しく集約されるか確かめてください。
それで良ければOpen "c:\my documents\aa23.csv" For Outputの"c:\my documents\aa23.csv"に集約されています。
旧DOS－Basicライクなコードですがご参考まで。
小数のファイルでしかテストしてませんので、エラーが出れば、直し方を伝え難いと思いますので、本回答は無視してください。

お礼

遅くまで付き合っていただき、ありがとうございます。

NO.2様、いつも助けていただき恐縮です。

明日早いので週末に、戻りましたらやってみます。

私に理解できるのか、相当不安ですが・・・

回答No.2

papayuka

#1です。

> 確かにこのコードはNO.1様の書かれたものです。

やっぱり。。。
前の質問の人に悪いことしちゃいました。(^-^；

> スクールに通った方がよいのでしょうね。

私は完全独学です。
記録マクロの書き換えとヘルプとメーリングリストで覚えました。ExcelVBAの本は１冊も買ってません。

サンプルは大量にあるので、コツを覚えると言うか、ある程度コードを追えるようになれば、私程度なら独学でも行けます。

下記の記録マクロがあったとしたら、

　Range("A1").Select
　Selection.Copy
　Range("A2").Select
　ActiveSheet.Paste

　A1を選択
　選択をコピー
　A2を選択
　アクティブシートに貼り付け

このように１行ずつ何をしているか追って行くとだんだん何処を直せば良いか解かってきますよ。