[已解决]将B列的品种和C列的规格相同的内容相加，其它的不变

雨玥

如何用VBA
将B列的品种和C列的规格相同的内容相加，其它的不变，并计算,想要的结果见附件。谢谢!

最佳答案

月排行榜 / 总排行榜

dsmch

2016-12-29 18:54

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = [a3:g12]
   
5. ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
6. For i = 1 To UBound(arr)
   
7.     zf = arr(i, 2) & "," & arr(i, 3)
   
8.     If Not d.exists(zf) Then
   
9.         s = s + 1
   
10.         d(zf) = s
    
11.         brr(s, 1) = s
    
12.         For j = 2 To UBound(arr, 2)
    
13.             brr(s, j) = arr(i, j)
    
14.         Next
    
15.     Else
    
16.         n = d(zf)
    
17.         brr(n, 4) = brr(n, 4) + arr(i, 4)
    
18.         brr(n, 6) = brr(n, 6) + arr(i, 6)
    
19.     End If
    
20. Next
    
21. [a3:g12] = ""
    
22. Range("a3").Resize(s, UBound(brr, 2)) = brr
    
23. [a3:a12].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
24. End Sub

复制代码

跳转到最佳答案楼层

望帝春心

1. 透视表

复制代码

心正意诚身修

望帝春心 发表于 2016-12-29 15:15

我看的时候也觉得透视可以完成。。如果用函数也比较简单。。不过看楼主指定用VBA。。。就没管了。

望帝春心

心正意诚身修 发表于 2016-12-29 18:34
我看的时候也觉得透视可以完成。。如果用函数也比较简单。。不过看楼主指定用VBA。。。就没管了。

我都没看他要用啥解决

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = [a3:g12]
   
5. ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
6. For i = 1 To UBound(arr)
   
7.     zf = arr(i, 2) & "," & arr(i, 3)
   
8.     If Not d.exists(zf) Then
   
9.         s = s + 1
   
10.         d(zf) = s
    
11.         brr(s, 1) = s
    
12.         For j = 2 To UBound(arr, 2)
    
13.             brr(s, j) = arr(i, j)
    
14.         Next
    
15.     Else
    
16.         n = d(zf)
    
17.         brr(n, 4) = brr(n, 4) + arr(i, 4)
    
18.         brr(n, 6) = brr(n, 6) + arr(i, 6)
    
19.     End If
    
20. Next
    
21. [a3:g12] = ""
    
22. Range("a3").Resize(s, UBound(brr, 2)) = brr
    
23. [a3:a12].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
24. End Sub

复制代码

雨玥

谢谢各位