[已解决]VBA最好用数组分类求和一条

vbyou127

VBA最好用数组分类求和一条

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-6-22 08:52

单纯用数组，字典都没用：

1. Sub xx()
   
2.     Dim arr, brr, i%, j%
   
3.     With Sheet1
   
4.         arr = .Range("A1").CurrentRegion
   
5.         brr = .Range("E1").CurrentRegion
   
6.         For i = 2 To UBound(arr, 1)
   
7.             For j = 2 To UBound(brr, 1)
   
8.                 If arr(i, 2) = brr(j, 1) Then brr(j, 2) = brr(j, 2) + arr(i, 3)
   
9.             Next
   
10.         Next
    
11.         .Range("E1").Resize(UBound(brr, 1), 2) = brr
    
12.     End With
    
13. End Sub

复制代码

跳转到最佳答案楼层

老司机带带我

单纯用数组，字典都没用：

1. Sub xx()
   
2.     Dim arr, brr, i%, j%
   
3.     With Sheet1
   
4.         arr = .Range("A1").CurrentRegion
   
5.         brr = .Range("E1").CurrentRegion
   
6.         For i = 2 To UBound(arr, 1)
   
7.             For j = 2 To UBound(brr, 1)
   
8.                 If arr(i, 2) = brr(j, 1) Then brr(j, 2) = brr(j, 2) + arr(i, 3)
   
9.             Next
   
10.         Next
    
11.         .Range("E1").Resize(UBound(brr, 1), 2) = brr
    
12.     End With
    
13. End Sub

复制代码

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a1").CurrentRegion
   
5. brr = Range("e1").CurrentRegion
   
6. For i = 2 To UBound(arr)
   
7.     d(arr(i, 2)) = d(arr(i, 2)) + arr(i, 3)
   
8. Next
   
9. For i = 2 To UBound(brr)
   
10.     brr(i, 2) = d(brr(i, 1))
    
11. Next
    
12. Range("e1").CurrentRegion = brr
    
13. End Sub

复制代码