(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ファイルを集計してみる
テストなのでファイル名が違うだけで各ファイル内容は同じです。
テストで使用したコード
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
