VBA でＣＳＶ集計

質問

VBAをはじめて１ヶ月のものです。
ＶＢＡの集計ツールを作成していますが
思うようにいかず、お知恵をお借りしたいと考えています。

abcというフォルダ配下に以下のように4桁の日付を示す
フォルダが日付毎にあります。（いくつあるかはわかりません。）
さらにその配下にいくつかのcsvファイルがおいてありますが
aaa.csvというcsvのみ抽出し
最終的には合体.csvのような集計ＣＳＶを作成したいと考えています。
以上よろしくお願いいたします。

(1) abc　→　0812フォルダ
＜aaa.csv＞　
　　　Ａ列　　　　　Ｂ列　　　　Ｃ列
１行　100　　　　　200 　　　8月12日 　　　　　　　　　　　　　　　　　　　　　
２行　100　　　　　100
３行　200　　　　　200
４行　300　　　　　100
５行　100　　　　　100
６行　200　　　　　200
７行　400　　　　　100
８行　100　　　　　100

(2)abc　→　0813フォルダ
＜aaa.csv＞　
　　　　Ａ列　　　　　Ｂ列　　　　　Ｃ列
１行　　　0　　　　　 300　　　　8月13日 　　　　　　　　　　　　
２行　100　　　　　　100
３行　100　　　　　　200
４行　100　　　　　　200
５行　100　　　　　　200
６行　300　　　　　　200
７行　300　　　　　　400
８行　200　　　　　　100

↓
(3)<合体.csv>
　　　　Ａ列　　　　　Ｂ列　　　　　　Ｃ列　　　　　Ｄ列　　　　 Ｅ列　　　　　Ｆ列　　　　　G列
　　　(日付）　　（A1～A4計）（Ａ5～Ａ8計）（合体B+C）（B1～B4計）（B5～B8計）（合体E+F）
１行　8月12日　　　700　　　　　 800　　　　　1500　　　　　600　　　　　500　　　　　1100
２行　8月13日　　　300　　　　　 900　　　　　1200　　　　　800　　　　　900　　　　　1700

回答No.2

fumufumu_2006

ANo.1です。
どこでどんなエラーになりますか？

Dim fso As New FileSystemObject
で、「ユーザ定義型は定義されていません。」の場合は、参照設定でMicrosoft Scripting Runtimeの参照にチェックを入れてください。
方法は、VisualBasicの画面で、「ツール」->「参照設定」で、「参照可能なライブラリファイル」の中の「Microsoft Scripting Runtime」のチェックを入れてください。
どうしてもわからない場合は、
Dim fso As New FileSystemObject
Dim fld As Folder
の部分を
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fld As Object
に変更してください。

「実行時エラー76：パスがみつかりません。」の場合は、パスが正しくありません。
まずこのVBAがあるブックを保存してください。
そのブックのあるフォルダの中のabcと言うフォルダが必要です。
例えば、このブックがc:\book1.xlsなら、c:\abc\0812\aaa.csvと言うファイルがある場合です。
このブックがc:\test\book1.xlsなら、c:\test\abc\0812\aaa.csvと言うファイルがある場合です。
または、「ThisWorkbook.Path & "\abc"」の部分を、「"c:\abc"」とかのabcの絶対パスに変えてください。
この時、結果書き込みの部分の「ThisWorkbook.Path & "\abc\合体.csv"」の部分も「c:"\abc\合体.csv"」とかにしてください。

回答No.1

fumufumu_2006

こんなのではどうでしょうか？

'参照設定でMicrosoft Scripting Runtimeの参照にチェックを入れてください
Option Explicit
Sub test()
Dim fso As New FileSystemObject
Dim fld As Folder
Dim srcRows() As String
Dim srcCols() As String
Dim dstRows() As String
Dim dstCols(6) As Variant
Dim r As Integer
dstRows() = Split("", " ") 'ubound(dstRows)=-1にするための初期化

'このBookのフォルダにあるabcフォルダ以下のフォルダを調べる
For Each fld In fso.GetFolder(ThisWorkbook.Path & "\abc").SubFolders
'aaa.csv読み込み
With fso.GetFile(fld & "\aaa.csv").OpenAsTextStream
srcRows = Split(.ReadAll, vbCrLf)
.Close
End With
'日付取得
dstCols(0) = Split(srcRows(0), ",")(2)
'1-4
dstCols(1) = 0
dstCols(4) = 0
For r = 0 To 3
srcCols = Split(srcRows(r), ",")
dstCols(1) = dstCols(1) + Val(srcCols(0)) 'A1～A4計
dstCols(4) = dstCols(4) + Val(srcCols(1)) 'B1～B4計
Next
'5-8
dstCols(2) = 0
dstCols(5) = 0
For r = 4 To 7
srcCols = Split(srcRows(r), ",")
dstCols(2) = dstCols(2) + Val(srcCols(0)) 'A5～A8計
dstCols(5) = dstCols(5) + Val(srcCols(1)) 'B5～B8計
Next
'合計
dstCols(3) = dstCols(1) + dstCols(2)
dstCols(6) = dstCols(4) + dstCols(5)
'結果１行分追加
ReDim Preserve dstRows(UBound(dstRows) + 1)
dstRows(UBound(dstRows)) = Join(dstCols, ",")
Next

'結果書き込み
With fso.CreateTextFile(ThisWorkbook.Path & "\abc\合体.csv", True)
.Write Join(dstRows, vbCrLf)
.Close
End With

Set fso = Nothing
End Sub

補足

エラーになって実行できないのですが。