求兄弟们帮我把“每月材料摊销表”做下汇总，谢谢！

baby1950

1，1队~8队汇总到总表

2，总表材料名称型号不重复，分表材料名称型号可能重复。
3，刚学VBA,好像是for each 工作表，然后把工作表区域写进数组，然后用字典累计，再写进新数组，之后导入总表（这步肯定不会了），求兄弟们帮手指点。

shiruiqiang

这位大哥，把表汇总吗？

baby1950

shiruiqiang 发表于 2023-7-4 11:57
这位大哥，把表汇总吗？

谢谢！！学习中。。。

ykcbf1100

每月汇总。。。

baby1950

ykcbf1100 发表于 2023-7-4 12:32
每月汇总。。。

excelhome，excelhome，excelhome，乌拉

baby1950

ykcbf1100 发表于 2023-7-4 12:32
每月汇总。。。

s = arr(i, 4) & "|" & arr(i, 5): ss = arr(i, 3)
If arr(i, 2) <> Empty Then If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
                    d(s)(ss) = d(s)(ss) + arr(i, 7)【条目和数组的累加，改条目】
老师，【d(s)(ss) 可以这样写吗？怎么理解，求解惑】

shiruiqiang

baby1950 发表于 2023-7-8 11:02
s = arr(i, 4) & "|" & arr(i, 5): ss = arr(i, 3)
If arr(i, 2)  Empty Then If Not d.exists(s) Then ...

本来字典的名称叫d，现在重新创立了一个新字典叫dxxx,xxx就是(s)

feilanga

baby1950 发表于 2023-7-8 11:02
s = arr(i, 4) & "|" & arr(i, 5): ss = arr(i, 3)
If arr(i, 2)  Empty Then If Not d.exists(s) Then ...

字典嵌套，s为关键字，如果字典d不存在关键字s就创建一个字典d(s)    d(s)这是一个字典 关键字ss

feilanga

1. Sub ykcbf()
   
2.     ' 定义变量
   
3.     Dim arr, brr(1 To 10000, 1 To 14), d
   
4.     ' 创建字典对象
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     ' 设置目标工作表
   
7.     Set Sh = Sheet9
   
8.     ' 遍历所有工作表
   
9.     For Each sht In Sheets
   
10.         ' 排除目标工作表
    
11.         If sht.Name <> Sh.Name Then
    
12.             ' 获取当前工作表的数据范围
    
13.             arr = sht.UsedRange
    
14.             ' 遍历数据范围的行
    
15.             For i = 2 To UBound(arr)
    
16.                 ' 将第4列和第5列的值拼接为键，将第3列的值作为子键
    
17.                 s = arr(i, 4) & "|" & arr(i, 5)
    
18.                 ss = arr(i, 3)
    
19.                 ' 判断第2列是否为空
    
20.                 If arr(i, 2) <> Empty Then
    
21.                     ' 如果键不存在，则创建新的字典对象
    
22.                     If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
    
23.                     ' 将第7列的值累加到对应的子键上
    
24.                     d(s)(ss) = d(s)(ss) + arr(i, 7)
    
25.                 End If
    
26.             Next
    
27.         End If
    
28.     Next
    
29.     ' 将字典中的键值对复制到二维数组中
    
30.     For Each k In d.keys
    
31.         m = m + 1
    
32.         brr(m, 1) = m
    
33.         brr(m, 2) = Split(k, "|")(0)
    
34.         brr(m, 3) = Split(k, "|")(1)
    
35.     Next
    
36.     ' 在目标工作表上进行操作
    
37.     With Sh
    
38.         ' 清除偏移量为5的范围内的内容
    
39.         .UsedRange.Offset(5).Clear
    
40.         ' 将二维数组的值复制到指定范围
    
41.         .[a6].Resize(m, 3) = brr
    
42.         ' 设置指定范围的边框样式
    
43.         .[a6].Resize(m, 14).Borders.LineStyle = 1
    
44.         ' 获取最后一行的行号
    
45.         r = .Cells(.Rows.Count, "a").End(3).Row
    
46.         ' 获取数据范围（从第3行开始）的值
    
47.         arr = .[a3].Resize(r - 2, 14)
    
48.         ' 遍历数据范围的行
    
49.         For i = 4 To UBound(arr)
    
50.             ' 将第2列和第3列的值拼接为键
    
51.             s = arr(i, 2) & "|" & arr(i, 3)
    
52.             Sum = 0
    
53.             ' 遍历第5列到第12列
    
54.             For j = 5 To 12
    
55.                 ' 将字典中对应键和子键的值赋给数据范围的对应位置
    
56.                 ss = arr(2, j)
    
57.                 arr(i, j) = d(s)(ss)
    
58.                 ' 累加求和
    
59.                 Sum = Sum + arr(i, j)
    
60.             Next
    
61.             ' 将求和结果赋给第13列
    
62.             arr(i, 13) = Sum
    
63.         Next
    
64.         ' 将修改后的数组值赋回数据范围
    
65.         With .[a3].Resize(r - 5, 14)
    
66.             .Value = arr
    
67.             ' 设置边框样式
    
68.             .Borders.LineStyle = 1
    
69.             ' 水平居中对齐
    
70.             .HorizontalAlignment = xlCenter
    
71.             ' 垂直居中对齐
    
72.             .VerticalAlignment = xlCenter
    
73.             ' 自动调整列宽
    
74.             .EntireColumn.AutoFit
    
75.         End With
    
76.     End With
    
77. End Sub
    

复制代码

feilanga

字典d条目立柱的值里面又放了一个字典d(s)    字典d(s）里面条目是1队，值为30