用VBA从同个文件夹下面的多个工作簿，透视各个维度汇总自动生成以上模板的汇总表

glenstyle

shiruiqiang 发表于 2024-3-22 20:05
自动生成，时间需要稍多点吧

谢谢老师，这个代码很好用，如果要再加上一个订单量的维度要怎么处理呢？

shiruiqiang

一个订单量的维度?

glenstyle

shiruiqiang 发表于 2024-3-26 10:45
一个订单量的维度?

说错了，应该叫统计维度的订单量，就是在金额的后面统计它各个类型有多少笔订单

glenstyle

shiruiqiang 发表于 2024-3-26 10:45
一个订单量的维度?

老师，在结算数那一列，我使用了IFERROR公式让报错的单元格变成空值，然后执行代码会报错为：“类型不匹配”，这个有办法解决吗？

cnmlgb9998

用PQ吧，方便！！！！！！！！！！！！！！！

shiruiqiang

cqr123

留个位置再说

ykcbf1100

参与一下，附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.4.22
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     Dim tm: tm = Timer
   
7.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
8.     bt = [{"账期", "品类", "暂估数", "实际数", "金额", "订单数"}]
   
9.     p = ThisWorkbook.Path & ""
   
10.     For Each f In fso.GetFolder(p).Files
    
11.         If f.Name Like "*.xls*" Then
    
12.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
13.                 fn = fso.GetBaseName(f)
    
14.                 Set wb = Workbooks.Open(f, 0)
    
15.                 With wb.Sheets(1)
    
16.                     r = .Cells(Rows.Count, 1).End(3).Row
    
17.                     c = .UsedRange.Columns.Count
    
18.                     arr = .[a1].Resize(r, c)
    
19.                     wb.Close False
    
20.                 End With
    
21.                 For j = 3 To 6
    
22.                     For i = 2 To UBound(arr)
    
23.                         s = arr(1, j): ss = Format(arr(i, 2), "yyyy年m月") & "|" & arr(i, j)
    
24.                         If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
    
25.                         If Not d(s).exists(ss) Then
    
26.                     
    
27.                             d(s)(ss) = Array(arr(i, 7), arr(i, 8), arr(i, 9), 1)
    
28.                         Else
    
29.                             t = d(s)(ss)
    
30.                             t(0) = t(0) + arr(i, 7)
    
31.                             t(1) = t(1) + arr(i, 8)
    
32.                             t(2) = t(2) + arr(i, 9)
    
33.                             t(3) = t(3) + 1
    
34.                             d(s)(ss) = t
    
35.                         End If
    
36.                     Next
    
37.                 Next
    
38.             End If
    
39.         End If
    
40.     Next f
    
41.     c = 1
    
42.     With sh
    
43.         .Cells.Clear
    
44.         For Each k In d.keys
    
45.             m = 1
    
46.             ReDim brr(1 To 10000, 1 To 6)
    
47.             For n = 1 To 6
    
48.                 brr(1, n) = bt(n)
    
49.             Next
    
50.             brr(1, 2) = k
    
51.             For Each kk In d(k).keys
    
52.                 b = Split(kk, "|")
    
53.                 t = d(k)(kk)
    
54.                 m = m + 1
    
55.                 brr(m, 1) = b(0)
    
56.                 brr(m, 2) = b(1)
    
57.                 For x = 3 To 6
    
58.                     brr(m, x) = t(x - 3)
    
59.                 Next
    
60.             Next
    
61.             .Cells(1, c).Resize(1, 6).Interior.Color = 49407
    
62.             With .Cells(1, c).Resize(m, 6)
    
63.                 .Value = brr
    
64.                 .Borders.LineStyle = 1
    
65.                 .HorizontalAlignment = xlCenter
    
66.                 .VerticalAlignment = xlCenter
    
67.             End With
    
68.             c = c + 7
    
69.         Next
    
70.     End With
    
71.     Set d = Nothing
    
72.     Application.ScreenUpdating = True
    
73.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
74. End Sub
    
75. 
    

复制代码