電子書籍の厳選無料作品が豊富!

VBAをはじめて1ヶ月のものです。
VBAの集計ツールを作成していますが
思うようにいかず、お知恵をお借りしたいと考えています。
   
abcというフォルダ配下に以下のように4桁の日付を示す
フォルダが日付毎にあります。(いくつあるかはわかりません。)
さらにその配下にいくつかのcsvファイルがおいてありますが
aaa.csvというcsvのみ抽出し
最終的には合体.csvのような集計CSVを作成したいと考えています。
以上よろしくお願いいたします。

(1) abc → 0812フォルダ
<aaa.csv> 
   A列     B列    C列
1行 100     200    8月12日                      
2行 100     100
3行 200     200
4行 300     100
5行 100     100
6行 200     200
7行 400     100
8行 100     100

(2)abc → 0813フォルダ
<aaa.csv> 
    A列     B列     C列
1行   0      300    8月13日             
2行 100      100
3行 100      200
4行 100      200
5行 100      200
6行 300      200
7行 300      400
8行 200      100



(3)<合体.csv>
    A列     B列      C列     D列     E列     F列     G列
   (日付)  (A1~A4計)(A5~A8計)(合体B+C)(B1~B4計)(B5~B8計)(合体E+F)
1行 8月12日   700      800     1500     600     500     1100
2行 8月13日   300      900     1200     800     900     1700

A 回答 (2件)

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"」とかにしてください。
    • good
    • 0

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



'参照設定で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)
'結果1行分追加
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

この回答への補足

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

補足日時:2008/02/17 10:46
    • good
    • 0

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