|
- Sub 汇总()
- Application.ScreenUpdating = False
- Dim Wb As Workbook, Sh As Worksheet
- Set fso = CreateObject("scripting.filesystemobject")
- Set d = CreateObject("scripting.dictionary")
- Set ff = fso.getfolder(ThisWorkbook.Path) '当前文件夹
- Dim brr(1 To 10000, 1 To 6)
- For Each fff In ff.subfolders '所有子文件夹
- For Each f In fff.Files '子文件夹中的所有文件
- yf = Val(Mid(Replace(f, fff, ""), 2)) & "月份" '根据文件名截取月份
- Set Wb = Workbooks.Open(f)
- Set Sh = Wb.Worksheets("产量")
- arr = Sh.Range("a1:n" & Sh.[d65536].End(3).Row)
- For i = 11 To UBound(arr)
- If arr(i, 2) Like "*组" Then zu = Trim(arr(i, 2))
- If arr(i, 4) = "标段" Then Exit For
- If arr(i, 4) <> "" Then '把所有内容存入数组Brr,并按地名分组
- dm = Left(arr(i, 4), 2) '地名
- n = n + 1
- brr(n, 2) = arr(i, 4) '标段名称
- brr(n, 3) = arr(i, 6) '数量
- brr(n, 4) = arr(i, 9) '总重量
- brr(n, 5) = yf '月份
- brr(n, 6) = zu '制作组
- d(dm) = d(dm) & "," & n '把行数按地名分组
- End If
- Next
- Wb.Close False
- Next
- Next
-
- dk = d.keys: dt = d.items
- For i = 0 To UBound(dk)
- Sheets("表式").Copy after:=Sheets(Sheets.Count)
- With ActiveSheet
- .Name = dk(i) '表名
- xrr = Split(dt(i), ",") '还原按地名分组的各行
- ReDim crr(1 To UBound(xrr), 1 To 6)
- For j = 1 To UBound(xrr)
- n = Val(xrr(j))
- crr(j, 1) = j
- For k = 2 To 6
- crr(j, k) = brr(n, k)
- Next
- Next
- .[b5].Resize(j - 1, 6) = crr
- End With
- Next
- Sheets(1).Activate
- Application.ScreenUpdating = True
- End Sub
- Sub 删除()
- Application.DisplayAlerts = False
- For Each Sh In Worksheets
- If Sh.Index > 2 Then Sh.Delete
- Next
- Application.DisplayAlerts = True
- End Sub
复制代码 |
|