同工作薄不同工作表汇总VBA代码

roc.jame

同工作薄不同工作表汇总VBA代码1、行跟列（涂红部分）需要将各个工作表的行、列的名字汇总去重后显示
2、一般情况下涂颜色部分不会变动
3、需要实现累计求和汇总的功能


我的想法是：汇总表里面的行标题 与 列标题 通过汇总各个表的行、列后取不重复值生成新的行标题、列标题，然后根据新的行列交叉得到的xy值 汇总所有表中的数据。表中有两个合计，第一个合计为前面的不确定有多少列的名称的合计，后面的合计为黄颜色区域的合计，固定的。

LIUZHU

这个部分要不要汇总？

LIUZHU

一般来说，汇总的数据也要注明出处吧，难道“汇总”中不需要将工作表的名字作为单独的一列显示？

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.6.4
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set d1 = CreateObject("Scripting.Dictionary")
   
4.     Set d2 = CreateObject("Scripting.Dictionary")
   
5.     Set sh = ThisWorkbook.Sheets("汇总")
   
6.     ReDim brr(1 To 10000, 1 To 4)
   
7.     For Each sht In Sheets
   
8.         If sht.Name <> sh.Name Then
   
9.             With sht
   
10.                 r = .Cells(Rows.Count, 1).End(3).Row
    
11.                 c = .UsedRange.Columns.Count
    
12.                 arr = .[a1].Resize(r, c)
    
13.             End With
    
14.             For j = 5 To UBound(arr, 2) - 6
    
15.                 s = arr(1, j)
    
16.                 d1(s) = ""
    
17.             Next
    
18.             For i = 2 To UBound(arr)
    
19.                 s = arr(i, 2)
    
20.                 If Not d2.exists(s) Then
    
21.                     m = m + 1
    
22.                     d2(s) = m
    
23.                     For j = 1 To 4
    
24.                         brr(m, j) = arr(i, j)
    
25.                     Next
    
26.                 End If
    
27.                 For j = 5 To UBound(arr, 2)
    
28.                     If arr(1, j) <> Empty Then
    
29.                         s = arr(i, 2) & "|" & arr(1, j)
    
30.                         d(s) = d(s) + arr(i, j)
    
31.                     End If
    
32.                 Next
    
33.             Next
    
34.         End If
    
35.     Next
    
36.     With sh
    
37.         .UsedRange.Offset(1).Clear
    
38.         c = .UsedRange.Columns.Count
    
39.         .[e1:r1] = ""
    
40.         .[e1].Resize(, d1.Count) = d1.keys
    
41.         .[a2].Resize(m, 4) = brr
    
42.         With .[a2].Resize(m, c)
    
43.             .Borders.LineStyle = 1
    
44.             .HorizontalAlignment = xlCenter
    
45.             .VerticalAlignment = xlCenter
    
46.         End With
    
47.         arr = .[a1].Resize(m + 1, c)
    
48.         For i = 2 To UBound(arr)
    
49.             For j = 5 To UBound(arr, 2)
    
50.                 If arr(1, j) <> Empty Then
    
51.                     s = arr(i, 2) & "|" & arr(1, j)
    
52.                     If d.exists(s) Then
    
53.                         .Cells(i, j) = d(s)
    
54.                     End If
    
55.                 End If
    
56.             Next
    
57.         Next
    
58.         ActiveWindow.DisplayZeros = False
    
59.     End With
    
60. End Sub
    
61. 
    

复制代码

roc.jame

LIUZHU 发表于 2024-6-4 10:58
一般来说，汇总的数据也要注明出处吧，难道“汇总”中不需要将工作表的名字作为单独的一列显示？

如果著名的话会不会没地方标记了啊

roc.jame

ykcbf1100 发表于 2024-6-4 12:46
附件供参考。。。

收到  非常感谢，学习了   您这个是固定列数下的，如果列数是根据所有表格的列标题取唯一值后  在合计、然后统计后面的部分的话，会直接丢失掉了

roc.jame

ykcbf1100 发表于 2024-6-4 12:47
参与一下。。。

感谢感谢  不过如果删除了列，后面的合计项目还是会消失掉啊。我原本是想由于表格太多，到时候具体有多少列都不确定，只能根据每个工作薄的列的名单汇总然后去掉重复值后，再粘贴成多少列，然后再复制【合计-合计】的数据汇总

ykcbf1100

roc.jame 发表于 2024-6-4 14:16
感谢感谢  不过如果删除了列，后面的合计项目还是会消失掉啊。我原本是想由于表格太多，到时候具体有多少 ...

你这个表格设计得有问题的，我能帮你做已经算可以了。
要求再多，你就等别人来帮你吧。

roc.jame

ykcbf1100 发表于 2024-6-4 14:30
你这个表格设计得有问题的，我能帮你做已经算可以了。
要求再多，你就等别人来帮你吧。

好的  谢谢