多数のCSVファイルを集計する

CSVファイルを扱う場合、
(1)基幹システム等から対象のデータを１ファイルでドカッと落としてきてその中で処理を行うような場合と、
(2)対象となる多数のCSVファイルがあって、各ファイルの中の該当するデータを抜き出したり集計したりする場合などがあると思います。

今回は後者の方です。
方針はいろんな立て方があると思います。
エクセルで処理をするので、各CSVをワークシートに読み込んで、一つの大きな表に結合して集計するんでも良いんです。
でも、セルの読み書きって時間がかかるので、それなら、CSVを配列に直接読み込んで集計すれば良いと思うんです。
まあ、そうなっちゃうとエクセルで処理してることになるのかどうかはちょっと疑問ではありますが。
で、多数のファイルを処理する場合、リストと照らし合わせてファイルの有無のチェックをするよりは、対象ファイルを一つのフォルダに入れて、それをリスト化して片っ端に処理した方が良いように思います。

フォルダ内のファイルのフルパスを配列に読み込む

やってると、buff=Dir(hoge) Do While buff<>"" ～ buff=Dir() Loop の間に処理を書くと、ファイルの読み込みがうまくいかなくなったりしたので、一旦対象ファイルを配列に読み込むことにしました。
ここでは拡張子指定にしてるけど、ファイル名に含まれる文字列で指定する等々簡単に書き直せるので、サンプルとしてはこんなので良いように思います。

'================================================'
    Function FullNamesIntoArrayByExtension( _
        ByVal strFolder As String, _
        ByVal strExtension As String _
    ) As Variant
' --------------------------------------------- '
'   フォルダ内指定した拡張子の全ファイルの'
'   フルパスを配列に読込む'
'   指定した拡張子のファイルが無い場合は'
'   Ubound(取得した配列) = -1 を返す'
'================================================'

    Dim strFullName As String
    Dim i As Long
    Dim buff As Variant
    Dim arrFiles() As String
    
        i = 0
        strFullName = strFolder & "\" & "*." & strExtension '"
        buff = Dir(strFullName)
        
        Do While buff <> ""
            ReDim Preserve arrFiles(i)
            arrFiles(i) = strFolder & "\" & buff '"
            i = i + 1
            buff = Dir()
        Loop
        
        If (Not arrFiles) = -1 Then
            ReDim arrFiles(-1 To -1)
            FullNamesIntoArrayByExtension = arrFiles
        Else
            FullNamesIntoArrayByExtension = arrFiles
        End If
    
    End Function

CSVファイルを配列に読込む

tetsuさんのブログですごく詳しく調べてあったので、参考にして、バイナリで読み込んで配列を戻す関数を書いてみました。

CSVファイルを配列に読込む関数

'========================================'
    Function TextIntoArray( _
        ByVal pFilePath As String _
    ) As Variant
' -------------------------------------- '
'   CSVファイルを配列に読込む'
'   エラーが起きた場合は'
'   Ubound(取得した配列) = -1 を返す'
'========================================'
        Dim lFileNo     As Long
        Dim buff        As String
        Dim bBuff()     As Byte
        Dim arrBuff
        Dim i           As Long
        Dim j           As Long
        Dim lItemCnt    As Long
        Dim arrItem
        Dim arrData()
        
        ReDim arrData(-1 To -1)
        TextIntoArray = arrData
        
        On Error GoTo AbEnd
    
        lFileNo = FreeFile
        
        Open pFilePath For Binary As #lFileNo
        
        ReDim bBuff(LOF(lFileNo))
        Get #lFileNo, , bBuff
        
        Close #lFileNo
        
        buff = StrConv(bBuff(), vbUnicode)
        
        arrBuff = Split(buff, vbCrLf)
        lItemCnt = UBound(Split(arrBuff(0), ","))
        
        ReDim arrData(UBound(arrBuff), lItemCnt)
        
        For i = LBound(arrBuff) To UBound(arrBuff)
            arrItem = Split(arrBuff(i), ",")
            For j = LBound(arrItem) To UBound(arrItem)
                arrData(i, j) = arrItem(j)
            Next j
        Next i
        
        TextIntoArray = arrData
        
        Exit Function
        
    AbEnd:
        ReDim arrData(-1 To -1)
        TextIntoArray = arrData
    
    End Function

100,000のCSVファイルを集計してみる

このようなCSVファイルで、フラグ列に「S」が立っている行の２列目の値を１０万ファイル分合計してみました。
テストなのでファイル名が違うだけで各ファイル内容は同じです。

10万ファイルで350秒くらい。1000ファイルくらいなら3秒程度で終わるので、割と使えると思います。

テストで使用したコード

Sub 十万ファイルの集計()

    Dim arrFiles, sFile
    Dim sFolder As String
    Dim arrData
    Dim i As Long
    Dim fSum As Single
    Dim StartTime, EndTime
    
    StartTime = Timer
    
    sFolder = "C:\Users\user\Desktop\集計テスト"
    
    arrFiles = FullNamesIntoArrayByExtension(sFolder, "csv")
    If UBound(arrFiles) = -1 Then Exit Sub
    
    For Each sFile In arrFiles
        arrData = TextIntoArray(sFile)
        
        'CSVのFlag列の値が"S"の行のフィールド１列（2列目）の値を集計する'
        For i = LBound(arrData, 1) To UBound(arrData, 1)
            If arrData(i, 0) = "S" Then
                fSum = fSum + arrData(i, 1)
            End If
        Next i
    Next sFile
    
    EndTime = Timer
    
    MsgBox "合計値は" & Format(fSum, "#,###") & vbNewLine & _
           "所要時間（秒）：" & EndTime - StartTime

End Sub