[已解决]看的人多了，帮忙的人少了

mcgrady5213

看的人多了，帮忙的人少了

最佳答案

月排行榜 / 总排行榜

zjcat35

2012-2-21 11:47

1. Sub a()
   
2.   Dim i As Integer, k As Integer, j As Integer
   
3.       j = Cells(2, 2)
   
4.       k = 2
   
5.     For i = 2 To [a65536].End(3).Row
   
6.       If Cells(i + 1, 1) = Cells(i, 1) Then
   
7.         j = j + Cells(i + 1, 2)
   
8.       Else
   
9.         Cells(k, 3) = j
   
10.         k = i + 1
    
11.         j = Cells(i + 1, 2)
    
12.       End If
    
13.     Next i
    
14. End Sub

复制代码

跳转到最佳答案楼层

zjcat35

1. Sub a()
   
2.   Dim i As Integer, k As Integer, j As Integer
   
3.       j = Cells(2, 2)
   
4.       k = 2
   
5.     For i = 2 To [a65536].End(3).Row
   
6.       If Cells(i + 1, 1) = Cells(i, 1) Then
   
7.         j = j + Cells(i + 1, 2)
   
8.       Else
   
9.         Cells(k, 3) = j
   
10.         k = i + 1
    
11.         j = Cells(i + 1, 2)
    
12.       End If
    
13.     Next i
    
14. End Sub

复制代码

蓝天一片云

zjcat35 发表于 2012-2-21 11:47

好方法，又是改成数组就更好了。

zjcat35

蓝天一片云 发表于 2012-2-21 15:20
好方法，又是改成数组就更好了。

1. Sub a()
   
2. Dim i As Integer, k As Integer, j As Integer, arr
   
3. j = Cells(2, 2)
   
4. k = 1
   
5. ReDim arr(1 To [a65536].End(3).Row - 1)
   
6. For i = 2 To [a65536].End(3).Row
   
7. If Cells(i + 1, 1) = Cells(i, 1) Then
   
8. j = j + Cells(i + 1, 2)
   
9. Else
   
10. arr(k) = j
    
11. k = i
    
12. j = Cells(i + 1, 2)
    
13. End If
    
14. Next i
    
15. Range("c2").Resize(UBound(arr), 1) = Application.Transpose(arr)
    
16. End Sub

复制代码

数组的

hrpotter

蓝天一片云 发表于 2012-2-21 15:20
好方法，又是改成数组就更好了。

数组的

1. Sub test()
   
2.     Dim i, j As Long
   
3.     Dim ar
   
4.     ar = Range("a1:c" & Range("a65536").End(xlUp).Row)
   
5.     For i = UBound(ar) To 2 Step -1
   
6.         j = j + ar(i, 2)
   
7.         If ar(i, 1) <> ar(i - 1, 1) Then
   
8.             ar(i, 3) = j
   
9.             j = 0
   
10.         End If
    
11.     Next
    
12.     Range("c1:c65536").ClearContents
    
13.     Range("c1").Resize(UBound(ar)) = Application.Index(ar, , 3)
    
14. End Sub
    

复制代码

蓝天一片云

hrpotter 发表于 2012-2-21 19:21
数组的

数组方法好！学习了。谢谢！