[已解决]根据给定条件字计算数量

excelpxfans001

根据给定条件字计算数量   

最佳答案

月排行榜 / 总排行榜

grf1973

2015-12-2 15:53

1. Sub tt()
   
2.     Dim A, B, C
   
3.     arr = Range("a1:d" & [d65536].End(3).Row)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     ReDim brr(1 To UBound(arr), 1 To 8)
   
6.     For i = 2 To UBound(arr)
   
7.         If Len(arr(i, 1)) = 0 Then arr(i, 1) = arr(i - 1, 1)
   
8.         bh = arr(i, 1)
   
9.         If Not d.exists(arr(i, 1)) Then
   
10.             n = n + 1
    
11.             brr(n, 1) = arr(i, 1)
    
12.             d(arr(i, 1)) = n
    
13.         End If
    
14.         x = arr(i, 4)
    
15.         p = d(arr(i, 1))
    
16.         If InStr(x, "宽") Then
    
17.             A = Val(Split(x, "宽")(1))
    
18.             If InStr(x, "*") Then B = Val(Split(x, "*")(1)) Else B = 1
    
19.             If InStr(x, "分") Then C = Val(Split(x, "分")(1)) Else C = 1
    
20.             brr(p, 2) = brr(p, 2) + 2 * B     '装饰头
    
21.             If InStr(x, "双") Then brr(p, 3) = brr(p, 3) + 2 * B     '堵头
    
22.             s = IIf(InStr(x, "单"), 4, 5)
    
23.             brr(p, s) = brr(p, s) + (C + 1) * B      '单、双支架
    
24.             ss = IIf(InStr(x, "单"), 1, 2)
    
25.             brr(p, 6) = brr(p, 6) + Round(A * 8 * B * ss, 0) '吊环
    
26.             If C > 1 Then brr(p, 7) = brr(p, 7) + (C - 1) * B * ss '连接器
    
27.         End If
    
28.     Next
    
29.     With Sheet2
    
30.         .Cells.ClearContents
    
31.         .[a1].Resize(1, 8) = Array("序号", "装饰头", "堵头", "单杆支架", "双杆支架", "吊环", "连接器", "合计统计")
    
32.         For i = 1 To n
    
33.             For j = 2 To 7
    
34.                 If brr(i, j) > 0 Then brr(i, 8) = brr(i, 8) & "，" & .Cells(1, j) & "：" & brr(i, j)
    
35.             Next
    
36.             brr(i, 8) = Mid(brr(i, 8), 2)
    
37.         Next
    
38.         .[a2].Resize(n, 8) = brr
    
39.         .Activate
    
40.     End With
    
41. End Sub

复制代码

跳转到最佳答案楼层

JasonG

又有领导来布置任务了~~

excelpxfans001

JasonG 发表于 2015-12-2 11:34
又有领导来布置任务了~~

什么意思，如不愿意解，麻烦请勿占楼。

grf1973

1. Sub tt()
   
2.     Dim A, B, C
   
3.     arr = Range("a1:d" & [d65536].End(3).Row)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     ReDim brr(1 To UBound(arr), 1 To 8)
   
6.     For i = 2 To UBound(arr)
   
7.         If Len(arr(i, 1)) = 0 Then arr(i, 1) = arr(i - 1, 1)
   
8.         bh = arr(i, 1)
   
9.         If Not d.exists(arr(i, 1)) Then
   
10.             n = n + 1
    
11.             brr(n, 1) = arr(i, 1)
    
12.             d(arr(i, 1)) = n
    
13.         End If
    
14.         x = arr(i, 4)
    
15.         p = d(arr(i, 1))
    
16.         If InStr(x, "宽") Then
    
17.             A = Val(Split(x, "宽")(1))
    
18.             If InStr(x, "*") Then B = Val(Split(x, "*")(1)) Else B = 1
    
19.             If InStr(x, "分") Then C = Val(Split(x, "分")(1)) Else C = 1
    
20.             brr(p, 2) = brr(p, 2) + 2 * B     '装饰头
    
21.             If InStr(x, "双") Then brr(p, 3) = brr(p, 3) + 2 * B     '堵头
    
22.             s = IIf(InStr(x, "单"), 4, 5)
    
23.             brr(p, s) = brr(p, s) + (C + 1) * B      '单、双支架
    
24.             ss = IIf(InStr(x, "单"), 1, 2)
    
25.             brr(p, 6) = brr(p, 6) + Round(A * 8 * B * ss, 0) '吊环
    
26.             If C > 1 Then brr(p, 7) = brr(p, 7) + (C - 1) * B * ss '连接器
    
27.         End If
    
28.     Next
    
29.     With Sheet2
    
30.         .Cells.ClearContents
    
31.         .[a1].Resize(1, 8) = Array("序号", "装饰头", "堵头", "单杆支架", "双杆支架", "吊环", "连接器", "合计统计")
    
32.         For i = 1 To n
    
33.             For j = 2 To 7
    
34.                 If brr(i, j) > 0 Then brr(i, 8) = brr(i, 8) & "，" & .Cells(1, j) & "：" & brr(i, j)
    
35.             Next
    
36.             brr(i, 8) = Mid(brr(i, 8), 2)
    
37.         Next
    
38.         .[a2].Resize(n, 8) = brr
    
39.         .Activate
    
40.     End With
    
41. End Sub

复制代码

excelpxfans001

grf1973 发表于 2015-12-2 15:53

老师您好。 合并统计这一步能否帮忙再看下哦。

grf1973

不是已经合并好了吗？你的意思是一定在显示在原表旁边？

grf1973

请看附件。

grf1973

数据从第一行开始的。