| |
上の Try1() はメモリを贅沢に使用していました。
店舗が1400 あれば 1400個のDictionaryを同時使用していました。
1400ものDictionaryを使って統合処理すると、メモリが圧迫されて
実用にならないかもしれません。
で、
店舗別ファイルリストを先に作成して、リスト順にひとつづつ
店舗別統合を行うように改造してみました。
例によって
> VBEメニュ−[ツール]-[参照設定]より
> Microsoft Scripting Runtime に参照設定しておいてください
Sub Try2()
Dim dataFolder As String
Dim subFolder() As String, subCount As Long
Dim fo
Dim fileName As String
Dim i As Long
Dim t!
t = Timer()
'dataFolder = "C:\Documents and Settings\月間データ統合\" 'データフォルダ
dataFolder = "D:\(Data)\temp月間データ統合\" 'データフォルダ
If Right$(dataFolder, 1) <> "\" Then dataFolder = dataFolder & "\"
'データフォルダ内のサブフォルダ名を取得
ReDim subFolder(1 To 40) '40日分
fileName = Dir$(dataFolder & "*.*", vbDirectory)
Do While Len(fileName)
If (GetAttr(dataFolder & fileName) And vbDirectory) = vbDirectory Then
If Not (fileName Like ".*") Then ' サブフォルダならば
subCount = subCount + 1
subFolder(subCount) = dataFolder & fileName & "\"
End If ' (\20091201 のような)
End If
fileName = Dir$() '次のフォルダ名を取得
Loop
ReDim Preserve subFolder(1 To subCount) '実在するSubFolder
'店舗別 ファイルリストを作成
Dim Dic As Dictionary
Dim nDic As Long
Dim 店舗名 As String
Dim n As Long
Set Dic = New Dictionary
For Each fo In subFolder
fileName = Dir$(fo & "*.csv")
While Len(fileName) '(ある日付のFolder内の) 店舗名.csv 取得
店舗名 = Left$(fileName, InStrRev(fileName, ".") - 1)
If Not Dic.Exists(店舗名) Then nDic = nDic + 1
Dic(店舗名) = Dic(店舗名) & "," & _
Replace(fo, dataFolder, "", Compare:=vbTextCompare) & fileName
fileName = Dir$() '次のCSVファイル名
Wend
Next
'店舗別 集計 統合ファイル出力
Dim 店舗
Dim vv, v
Dim io As Integer
Dim buf() As Byte
Dim myCSV
Dim tbl As Dictionary '商品別統合用テーブル
Application.ScreenUpdating = False
io = FreeFile()
For Each 店舗 In Dic.Keys()
Set tbl = New Dictionary 'テーブル初期化
For Each myCSV In Split(Mid$(Dic(店舗), 2), ",")
'指定のCSVファイルを開き、商品別に数量集計
Open dataFolder & myCSV For Binary As io
ReDim buf(1 To LOF(io))
Get #io, , buf
Close io
vv = Split(StrConv(buf, vbUnicode), vbCrLf)
Set tbl = New Dictionary
For i = 0 To UBound(vv) - 1
v = Split(vv(i), ",")
tbl(v(1)) = tbl(v(1)) + Val(v(2)) '統合
Next ' 商品 数量
Next
'↑以上である店舗の月間「統合」終了
'↓商品でソートしてから CSV出力する
With ThisWorkbook.Worksheets(1)
.Cells(1).Resize(tbl.Count, 2).Value = _
Application.Transpose(Array(tbl.Keys, tbl.Items))
.UsedRange.Sort Key1:=.Columns(1), Header:=xlNo
vv = .UsedRange.Value
.UsedRange.ClearContents
End With
ReDim v(1 To UBound(vv))
For i = 1 To UBound(vv)
v(i) = Join(Array(vv(i, 1), vv(i, 1), vv(i, 2)), ",")
Next
fileName = dataFolder & 店舗 & ".csv"
Open fileName For Output As io
Print #io, Join(v, vbCrLf)
Close io
Set tbl = Nothing
Next
Application.ScreenUpdating = True
Set Dic = Nothing
Debug.Print "'Try2", Timer() - t
MsgBox nDic & "店舗の 統合が完了しました"
End Sub
実行Speedは 先ほどと同じデータ↓
> 20フォルダ(20日) 400店舗(各フォルダ内に 400のCsvファイル)
(ひとつのCSVファイルは 約5000行です)
で、Try1とほぼ同じでした。
Try2 167秒 (約 3分)
|
|
kanabun
- 10/1/2(土) 23:21 -
