求用字典写个汇总代码

ty1014 · 发表于 2018-7-22 14:30

CC例例发表于 2018-7-22 13:00
k是一维数组，存放的元素是3个费率，下标是0，而变量x起始的值是2，所以减2

新序号供应商型号名称
1 A L7B-01-04 制动轮
2 A L2W-01-06B 制动轮
3 A L2W-01-06B 制动轮
4 A L7B-01-04 制动轮
5 A L5I-01-04 制动轮
6 A L5I-01-04 制动轮
7 A L7B-01-04 制动轮
8 A L5I-01-04 制动轮
9 A L7B-01-04 制动轮
(1)A小计(1)：1-9项之和
(2)销售费：小计(1)×1.5%
(3)手续费：小计(1)×1.2%
(4)保管费：小计(1)×1.4%
合计(1)：(1)-(4)之和
10 B L5I-01-04 制动轮
朋友，能不能在小计后面加上一个序号，这是A类的，余下类推，谢谢

CC例例 · 发表于 2018-7-22 15:03

ty1014 发表于 2018-7-22 14:30
新序号供应商型号名称
1 A L7B-01-04 制动轮
2 A L2W-01-06B 制动轮

Sub 分类汇总()
Dim d As Object, arA, arB, arC, k()
Dim i&, x&, y&, j%, c%, p%, x1&, x2&, n As Double, n1 As Double, n2 As Double
Set d = CreateObject("Scripting.Dictionary")
arC = Sheet2.Range("n1").CurrentRegion
Range("a1").CurrentRegion.Offset(2).ClearContents
For i = 3 To UBound(arC)
ReDim k(2)
For x = 2 To 4
k(x - 2) = arC(i, x)
Next
d(arC(i, 1)) = k
Next
arA = Sheet2.Range("a3:i" & Sheet2.Cells(Rows.Count, 1).End(3).Row + 1)
ReDim arB(1 To UBound(arA) + d.Count * 5, 1 To UBound(arA, 2))
For i = 1 To UBound(arA) - 1
If i = 1 Then x1 = arA(i, 1)
n = n + arA(i, 8)
y = y + 1
For x = 1 To UBound(arA, 2)
arB(y, x) = arA(i, x)
Next
If arA(i, 2) <> arA(i + 1, 2) Then
j = Application.CountA(d(arA(i, 2)))
c = c + 1
x2 = arA(i, 1)
If j > 0 Then
y = y + 1
p = p + 1
arB(y, 3) = "(" & p & ")" & arA(i, 2) & "小计(" & c & ")：" & x1 & "-" & x2 & "项之和"
arB(y, 8) = n
k = d(arA(i, 2))
For x = 0 To UBound(k)
If Trim(k(x)) <> "" Then
y = y + 1
p = p + 1
arB(y, 3) = "(" & p & ")" & Replace(arC(2, x + 2), "率", "") & "小计×" & k(x) * 100 & "%"
arB(y, 8) = Round(n * k(x), 2)
n1 = n1 + arB(y, 8)
End If
Next
End If
y = y + 1
arB(y, 3) = IIf(p = 0, arA(i, 2), "") & "合计(" & c & ")：" & IIf(p > 0, "(1)-(" & p & ")之和", x1 & "-" & x2 & "项之和")
arB(y, 8) = n + n1
n2 = n2 + arB(y, 8)
n = 0
n1 = 0
p = 0
x1 = arA(i + 1, 1)
End If
Next
y = y + 2
arB(y, 3) = "总计：合计(1)-(" & c & ")之和"
arB(y, 8) = n2
Range("a3").Resize(y, UBound(arB, 2)) = arB
End Sub

复制代码

ty1014 · 发表于 2018-7-22 15:43

CC例例发表于 2018-7-22 15:03

谢谢，请问下dim k(2)怎么解释

ty1014 · 发表于 2018-7-22 17:28

CC例例发表于 2018-7-22 15:03

代码速度很快，不错，虽然有的地方还看不明白，谢谢。
如果黄色区域中数据为0，能不能加个判断直接算总计，而不要里面的合计（5）合计（6）类的这些行，只要总计行。谢谢
E合计(5)：28-32项之和 508006
F L5N-01-05 制动轮只 220 1901 418220 行420341
F L5N-01-06 制动轮只 155 1902 294810 296867
F合计(6)：33-34项之和 713030

总计：合计(1)-(6)之和 6504796

CC例例 · 发表于 2018-7-22 19:01

ty1014 发表于 2018-7-22 17:28
代码速度很快，不错，虽然有的地方还看不明白，谢谢。
如果黄色区域中数据为0，能不能加个判断直接算总 ...

Sub 分类汇总()
Dim d As Object, arA, arB, arC, k()
Dim i&, x&, y&, c%, p%, x1&, x2&, n As Double, n1 As Double, n2 As Double, sMax As Double
Set d = CreateObject("Scripting.Dictionary")
arC = Sheet2.Range("n1").CurrentRegion
Range("a1").CurrentRegion.Offset(2).ClearContents
For i = 3 To UBound(arC)
ReDim k(2)
For x = 2 To 4
k(x - 2) = arC(i, x)
Next
d(arC(i, 1)) = k
Next
arA = Sheet2.Range("a3:i" & Sheet2.Cells(Rows.Count, 1).End(3).Row + 1)
ReDim arB(1 To UBound(arA) + d.Count * 5, 1 To UBound(arA, 2))
For i = 1 To UBound(arA) - 1
If i = 1 Then x1 = arA(i, 1)
n = n + arA(i, 8)
y = y + 1
For x = 1 To UBound(arA, 2)
arB(y, x) = arA(i, x)
Next
If arA(i, 2) <> arA(i + 1, 2) Then
sMax = Application.Max(d(arA(i, 2)))
c = c + 1
x2 = arA(i, 1)
If sMax > 0 Then
y = y + 1
p = p + 1
arB(y, 3) = "(" & p & ")" & arA(i, 2) & "小计(" & c & ")：" & x1 & "-" & x2 & "项之和"
arB(y, 8) = n
k = d(arA(i, 2))
For x = 0 To UBound(k)
If Trim(k(x)) > 0 Then
y = y + 1
p = p + 1
arB(y, 3) = "(" & p & ")" & Replace(arC(2, x + 2), "率", "") & "小计×" & k(x) * 100 & "%"
arB(y, 8) = Round(n * k(x), 2)
n1 = n1 + arB(y, 8)
End If
Next
End If
y = y + 1
arB(y, 3) = IIf(p = 0, arA(i, 2), "") & "合计(" & c & ")：" & IIf(p > 0, "(1)-(" & p & ")之和", x1 & "-" & x2 & "项之和")
arB(y, 8) = n + n1
n2 = n2 + arB(y, 8)
n = 0
n1 = 0
p = 0
x1 = arA(i + 1, 1)
End If
Next
y = y + 2
arB(y, 3) = "总计：合计(1)-(" & c & ")之和"
arB(y, 8) = n2
Range("a3").Resize(y, UBound(arB, 2)) = arB
End Sub

复制代码

ty1014 · 发表于 2018-7-22 20:21

CC例例发表于 2018-7-22 19:01

代码收到，粘贴到附件中运行后，那个原来的合计项还在，还没有变化，望朋友再抽时间看看

ty1014 · 发表于 2018-7-23 08:37

CC例例发表于 2018-7-22 19:01

朋友，如果黄色区域中数据为0，也就是没有费率，能不能加个判断直接算总计，计算直接计算，而不要里面的合计（5）合计（6）类的这些行，只要总计行。谢谢！
      E合计(5)：28-32项之和                                     508006
F       L5N-01-05       制动轮       只       220       1901       418220       行420341
F       L5N-01-06       制动轮       只       155       1902       294810       296867
      F合计(6)：33-34项之和                                     713030

      总计：合计(1)-(6)之和                                     6504796

ty1014 · 发表于 2018-7-23 21:27

CC例例发表于 2018-7-22 19:01

朋友，抽个时间再看看这个帖子，当费率区域为0时，不统计合计，直接在底部总计，可以实现吗？

CC例例 · 发表于 2018-7-24 08:26

ty1014 发表于 2018-7-23 21:27
朋友，抽个时间再看看这个帖子，当费率区域为0时，不统计合计，直接在底部总计，可以实现吗？

对于楼主这种无限制的要求，我很无语，别人也有工作。代码运行结果和楼主附件中的目标结果是一致的，楼主后面的要求也帮助更正啦，但这种无限制的更改要求，我很无助，也没有精力解答........

ty1014 · 发表于 2018-7-24 15:58

CC例例发表于 2018-7-24 08:26
对于楼主这种无限制的要求，我很无语，别人也有工作。代码运行结果和楼主附件中的目标结果是一致的，楼主 ...

谢谢朋友的帮助31

		自动登录	找回密码
密码			免费注册

[求助] 求用字典写个汇总代码

评分