Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


18226 / 76732 ←次へ | 前へ→

【63949】Re:マクロを早く快適に動かしたいです
発言  kanabun  - 10/1/2(土) 23:21 -

引用なし
パスワード
   上の 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分)
0 hits

【63908】マクロを早く快適に動かしたいです つよぽん 09/12/31(木) 6:33 質問
【63910】Re:マクロを早く快適に動かしたいです かみちゃん 09/12/31(木) 10:40 発言
【63914】Re:マクロを早く快適に動かしたいです kanabun 09/12/31(木) 14:09 発言
【63916】Re:マクロを早く快適に動かしたいです つよぽん 09/12/31(木) 15:13 発言
【63917】Re:マクロを早く快適に動かしたいです かみちゃん 09/12/31(木) 15:19 発言
【63918】Re:マクロを早く快適に動かしたいです Hirofumi 09/12/31(木) 15:31 回答
【63919】Re:マクロを早く快適に動かしたいです Hirofumi 09/12/31(木) 15:36 回答
【63921】Re:マクロを早く快適に動かしたいです Hirofumi 09/12/31(木) 17:12 回答
【63927】Re:マクロを早く快適に動かしたいです Hirofumi 09/12/31(木) 18:03 回答
【63928】Re:マクロを早く快適に動かしたいです かみちゃん 09/12/31(木) 18:10 発言
【63932】Re:マクロを早く快適に動かしたいです Hirofumi 09/12/31(木) 19:07 発言
【63933】Re:マクロを早く快適に動かしたいです かみちゃん 09/12/31(木) 19:40 発言
【63935】Re:マクロを早く快適に動かしたいです Hirofumi 09/12/31(木) 20:33 発言
【63936】Re:マクロを早く快適に動かしたいです かみちゃん 09/12/31(木) 21:01 発言
【63939】Re:マクロを早く快適に動かしたいです つよぽん 10/1/1(金) 18:32 質問
【63940】Re:マクロを早く快適に動かしたいです かみちゃん 10/1/1(金) 18:39 発言
【63942】Re:マクロを早く快適に動かしたいです つよぽん 10/1/1(金) 19:16 お礼
【63948】Re:マクロを早く快適に動かしたいです kanabun 10/1/2(土) 22:23 発言
【63949】Re:マクロを早く快適に動かしたいです kanabun 10/1/2(土) 23:21 発言
【63950】Re:マクロを早く快適に動かしたいです kanabun 10/1/2(土) 23:29 発言
【63920】Re:マクロを早く快適に動かしたいです kanabun 09/12/31(木) 17:08 発言
【63924】Re:マクロを早く快適に動かしたいです つよぽん 09/12/31(木) 17:48 発言
【63925】Re:マクロを早く快適に動かしたいです かみちゃん 09/12/31(木) 17:53 発言
【63929】Re:マクロを早く快適に動かしたいです かみちゃん 09/12/31(木) 18:41 発言
【63931】Re:マクロを早く快適に動かしたいです かみちゃん 09/12/31(木) 18:50 発言
【63937】Re:マクロを早く快適に動かしたいです かみちゃん 09/12/31(木) 21:04 発言
【63934】Re:マクロを早く快適に動かしたいです kanabun 09/12/31(木) 20:14 発言
【63938】Re:マクロを早く快適に動かしたいです kanabun 09/12/31(木) 22:54 発言
【63941】Re:マクロを早く快適に動かしたいです つよぽん 10/1/1(金) 18:57 発言
【63943】Re:マクロを早く快適に動かしたいです かみちゃん 10/1/1(金) 19:41 発言
【63930】Re:マクロを早く快適に動かしたいです よろずや 09/12/31(木) 18:44 発言
【63944】Re:マクロを早く快適に動かしたいです Yuki 10/1/2(土) 10:46 発言
【63945】Re:マクロを早く快適に動かしたいです かみちゃん 10/1/2(土) 11:11 発言

18226 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free