[已解决]VBA计算产量合计用两种方法

laoau138

VBA计算产量合计用两种方法

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-4-11 16:10

1. Sub aaa()
   
2. Dim arr, brr, i&, j&, k&
   
3. arr = [a1].CurrentRegion
   
4. ReDim brr(1 To UBound(arr), 1 To 2)
   
5. For i = 2 To UBound(arr)
   
6.   For k = 1 To UBound(brr)
   
7.     If brr(k, 1) = "" Then brr(k, 1) = arr(i, 2): Exit For
   
8.     If brr(k, 1) = arr(i, 2) Then Exit For
   
9.   Next k
   
10.   For j = 3 To UBound(arr, 2)
    
11.     brr(k, 2) = brr(k, 2) + arr(i, j)
    
12.   Next j
    
13. Next i
    
14. [j2].Resize(UBound(brr), 2) = brr
    
15. End Sub
    
16. 
    
17. Sub bbb()
    
18. Dim arr, brr, r&, i&, j&, d As Object
    
19. arr = [a1].CurrentRegion
    
20. ReDim brr(1 To UBound(arr), 1 To 2)
    
21. Set d = CreateObject("scripting.dictionary")
    
22. For i = 2 To UBound(arr)
    
23.   If Not d.exists(arr(i, 2)) Then
    
24.     r = r + 1
    
25.     d(arr(i, 2)) = r
    
26.     brr(r, 1) = arr(i, 2)
    
27.   End If
    
28.   For j = 3 To UBound(arr, 2)
    
29.     brr(d(arr(i, 2)), 2) = brr(d(arr(i, 2)), 2) + arr(i, j)
    
30.   Next j
    
31. Next i
    
32. [j2].Resize(d.Count, 2) = brr
    
33. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, i&, j&, k&
   
3. arr = [a1].CurrentRegion
   
4. ReDim brr(1 To UBound(arr), 1 To 2)
   
5. For i = 2 To UBound(arr)
   
6.   For k = 1 To UBound(brr)
   
7.     If brr(k, 1) = "" Then brr(k, 1) = arr(i, 2): Exit For
   
8.     If brr(k, 1) = arr(i, 2) Then Exit For
   
9.   Next k
   
10.   For j = 3 To UBound(arr, 2)
    
11.     brr(k, 2) = brr(k, 2) + arr(i, j)
    
12.   Next j
    
13. Next i
    
14. [j2].Resize(UBound(brr), 2) = brr
    
15. End Sub
    
16. 
    
17. Sub bbb()
    
18. Dim arr, brr, r&, i&, j&, d As Object
    
19. arr = [a1].CurrentRegion
    
20. ReDim brr(1 To UBound(arr), 1 To 2)
    
21. Set d = CreateObject("scripting.dictionary")
    
22. For i = 2 To UBound(arr)
    
23.   If Not d.exists(arr(i, 2)) Then
    
24.     r = r + 1
    
25.     d(arr(i, 2)) = r
    
26.     brr(r, 1) = arr(i, 2)
    
27.   End If
    
28.   For j = 3 To UBound(arr, 2)
    
29.     brr(d(arr(i, 2)), 2) = brr(d(arr(i, 2)), 2) + arr(i, j)
    
30.   Next j
    
31. Next i
    
32. [j2].Resize(d.Count, 2) = brr
    
33. End Sub

复制代码

laoau138

大灰狼1976 发表于 2017-4-11 16:10

VBA改写数组把成绩按班级分类

http://www.excelpx.com/thread-429261-1-1.html

laoau138

大灰狼1976 发表于 2017-4-11 16:10

果然是高手