| |
▼つよぽん さん：
>もう少し細かくお伝えすると、統合フォルダの中に20091201フォルダ、20091202フォルダと日付フォルダがあり、
>日付フォルダの中には1001csv、1002csv、1003csvと1400の店舗データがあります。
遅ればせながら、、、
統合する店舗の数だけ Dictionary配列に 統合テーブル作成して
最後にまとめて ファイル出力するサンプルです。
このサンプルを試すためには
★ VBEメニュ−[ツール]-[参照設定]より
Microsoft Scripting Runtime に参照設定しておいてください
Sub Try1()
Dim dataFolder As String
Dim subFolder() As String, subCount As Long
Dim fo
Dim fileName As String
Dim i As Long
Dim dic() As Dictionary
dataFolder = "C:\Documents and Settings\月間データ統合\" 'データフォルダ
'データフォルダ内のサブフォルダ名を取得
fileName = Dir$(dataFolder & "*.*", vbDirectory)
Do While Len(fileName)
If (GetAttr(dataFolder & fileName) And vbDirectory) = vbDirectory Then
If Not (fileName Like ".*") Then ' サブフォルダならば
subCount = subCount + 1
ReDim Preserve subFolder(1 To subCount)
subFolder(subCount) = dataFolder & fileName & "\"
End If
End If
fileName = Dir$() '次のフォルダ名を取得
Loop
Dim 店舗名 As String
Dim nDic As Long
Dim n As Long
ReDim dic(1500)
Set dic(0) = New Dictionary
For Each fo In subFolder
fileName = Dir$(fo & "*.csv")
While Len(fileName) '(ある日付の)店舗名.csv 取得
店舗名 = Left$(fileName, InStrRev(fileName, ".") - 1)
If Not dic(0).Exists(店舗名) Then
nDic = nDic + 1
n = nDic
dic(0).Item(店舗名) = n
Set dic(n) = New Dictionary
Else
n = dic(0).Item(店舗名)
End If
'------------
csv統合 fo & fileName, dic(n) '商品コード別集計
'------------
fileName = Dir$()
Wend
Next
'店舗別 統合ファイル出力
Dim 店舗, 商品 As String
Dim vv
Dim io As Integer
Application.ScreenUpdating = False
io = FreeFile()
For Each 店舗 In dic(0).Keys()
n = dic(0).Item(店舗)
With ThisWorkbook.Worksheets(1)
.Cells(1).Resize(dic(n).Count, 2).Value = _
Application.Transpose(Array(dic(n).Keys, dic(n).Items))
.UsedRange.Sort Key1:=.Columns(1), Header:=xlNo
vv = .UsedRange.Value
.UsedRange.ClearContents
End With
fileName = dataFolder & 店舗 & ".csv"
Open fileName For Output As io
For i = 1 To UBound(vv)
Print #io, Join(Array(vv(i, 1), vv(i, 1), vv(i, 2)), ",")
Next
Close io
Next
Application.ScreenUpdating = True
Erase dic
MsgBox nDic & "店舗の 統合が完了しました"
End Sub
'★ 指定のCSVファイルを開き、商品別に数量集計
Private Sub csv統合(myCSV As String, tbl As Dictionary)
Dim io As Integer
Dim buf() As Byte
io = FreeFile()
Open myCSV For Binary As io
ReDim buf(1 To LOF(io))
Get #io, , buf
Close io
Dim vv, v
Dim i As Long
vv = Split(StrConv(buf, vbUnicode), vbCrLf)
For i = 0 To UBound(vv) - 1
v = Split(vv(i), ",")
tbl(v(1)) = tbl(v(1)) + Val(v(2)) '統合
Next ' 商品 数量
End Sub
|
|
kanabun
- 09/12/31(木) 22:54 -
