[已解决]如何用VBA不重复汇总，谢谢。

新一

如何用VBA不重复汇总，谢谢。如附件

最佳答案

月排行榜 / 总排行榜

dsmch

2016-5-9 22:51

1. Sub Macro1()
   
2. Dim arr, brr(1 To 20000, 1 To 8), d, i%, j&, s&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. For i = 2 To Sheets.Count
   
5.     arr = Sheets(i).Range("a1").CurrentRegion
   
6.     For j = 2 To UBound(arr)
   
7.         zf = arr(j, 1) & "," & arr(j, 2) & "," & arr(j, 3)
   
8.         If Not d.exists(zf) Then
   
9.             s = s + 1
   
10.             d(zf) = s
    
11.             brr(s, 1) = arr(j, 1)
    
12.             brr(s, 2) = arr(j, 2)
    
13.             brr(s, 3) = arr(j, 3)
    
14.             brr(s, 8) = arr(j, 5)
    
15.             brr(s, i + 2) = arr(j, 4)
    
16.         Else
    
17.             brr(d(zf), i + 2) = brr(d(zf), i + 2) + arr(j, 4)
    
18.         End If
    
19.     Next
    
20. Next
    
21. For i = 1 To s
    
22.     brr(i, 7) = brr(i, 4) + brr(i, 5) - brr(i, 6)
    
23. Next
    
24. Range("a2").Resize(s, 8) = brr
    
25. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr(1 To 20000, 1 To 8), d, i%, j&, s&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. For i = 2 To Sheets.Count
   
5.     arr = Sheets(i).Range("a1").CurrentRegion
   
6.     For j = 2 To UBound(arr)
   
7.         zf = arr(j, 1) & "," & arr(j, 2) & "," & arr(j, 3)
   
8.         If Not d.exists(zf) Then
   
9.             s = s + 1
   
10.             d(zf) = s
    
11.             brr(s, 1) = arr(j, 1)
    
12.             brr(s, 2) = arr(j, 2)
    
13.             brr(s, 3) = arr(j, 3)
    
14.             brr(s, 8) = arr(j, 5)
    
15.             brr(s, i + 2) = arr(j, 4)
    
16.         Else
    
17.             brr(d(zf), i + 2) = brr(d(zf), i + 2) + arr(j, 4)
    
18.         End If
    
19.     Next
    
20. Next
    
21. For i = 1 To s
    
22.     brr(i, 7) = brr(i, 4) + brr(i, 5) - brr(i, 6)
    
23. Next
    
24. Range("a2").Resize(s, 8) = brr
    
25. End Sub

复制代码

新一

谢谢老大，么么达{:011:}