[已解决]求代码

yanyupingsheng

请高手指教，详见附件。

最佳答案

月排行榜 / 总排行榜

风化石

2012-11-13 09:42

Sub kkkk() '
r = Range("B65536").End(xlUp).Row '最后行数
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To r
        If Cells(i, 1).Value <> "" Then
            d(i) = 1
        End If
    Next

n = Join(d.keys, ",") & "," & r + 1
k = Split(n, ",")  '用Split将其分开，其结果为数组
For h = 0 To d.Count - 1
Cells(k(h), 4) = Application.Sum(Range("C" & k(h) & ":C" & k(h + 1) - 1))    '写入计算结果
Next
End Sub

副本Xl0000006.rar (10.65 KB, 下载次数: 4)

2012-11-13 09:42 上传

点击文件名下载附件

跳转到最佳答案楼层

风化石

Sub kkkk() '
r = Range("B65536").End(xlUp).Row '最后行数
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To r
        If Cells(i, 1).Value <> "" Then
            d(i) = 1
        End If
    Next

n = Join(d.keys, ",") & "," & r + 1
k = Split(n, ",")  '用Split将其分开，其结果为数组
For h = 0 To d.Count - 1
Cells(k(h), 4) = Application.Sum(Range("C" & k(h) & ":C" & k(h + 1) - 1))    '写入计算结果
Next
End Sub

副本Xl0000006.rar (10.65 KB, 下载次数: 4)

2012-11-13 09:42 上传

点击文件名下载附件

上清宫主

Sub test()
r% = 2
s% = Cells(2, 3)
For i% = 3 To Range("B65536").End(xlUp).Row
    If Cells(i, 1).Value <> "" Then
       Cells(r, 4) = s
       r = i
       s = Cells(i, 3)
    Else
       s = Cells(i, 3) + s
    End If
Next
Cells(r, 4) = s
End Sub

yanyupingsheng

谢谢。。。。。。。。