请教：记录循环分段--每段不超过50

鄂龙蒙

请教：下面的代码怎么改，才能循环到结束？谢谢！若一行数据超过50时就一行为一段。
Sub 记录循环分段()
    Dim arr, s, i, a, m, sa, br()
    arr = [A1].CurrentRegion.Value
    sa = 0: a = 2
        For i = 2 To UBound(arr)
            sa = sa + Cells(i, 2) * 1
            If sa > 50 Then
                s = i - 1
                m = m + 1
                ReDim Preserve br(1 To 3, 1 To m)
                br(1, m) = a
                br(2, m) = s
                br(3, m) = sa - arr(i, 2)
                Exit For
            End If
        Next
    sa = 0: a = s + 1
        For i = a To UBound(arr)
            sa = sa + Cells(i, 2) * 1
            If sa > 50 Then
                s = i - 1
                m = m + 1
                ReDim Preserve br(1 To 3, 1 To m)
                br(1, m) = a
                br(2, m) = s
                br(3, m) = sa - arr(i, 2)
                Exit For
            End If
        Next
    sa = 0: a = s + 1
        For i = a To UBound(arr)
            sa = sa + Cells(i, 2) * 1
            If sa > 50 Then
                s = i - 1
                m = m + 1
                ReDim Preserve br(1 To 3, 1 To m)
                br(1, m) = a
                br(2, m) = s
                br(3, m) = sa - arr(i, 2)
                Exit For
            End If
        Next
        '。。。。。。。。。请教：下面如何循环到结束，谢谢
    Range("E2:G10000").ClearContents
    [E2].Resize(m, 3) = Application.Transpose(br)
End Sub

记录循环分段--每段不超过50.rar (16.05 KB, 下载次数: 4)

2018-7-29 22:35 上传

点击文件名下载附件

microyip

1. Sub 记录循环分段()
   
2.     Dim vData As Variant, nRow As Integer
   
3.     Dim vFill As Variant, nFill As Integer
   
4.     Dim nSum As Integer, nStart As Integer
   
5.    
   
6.     ReDim vFill(1 To 3, 1 To 1)
   
7.     vData = [A1].CurrentRegion.Value
   
8.     nStart = 2
   
9.     nRow = 2
   
10.     Do While nRow <= UBound(vData)
    
11.         nSum = nSum + Val(vData(nRow, 2))
    
12.         If nSum + Val(vData(nRow - (nRow < UBound(vData)) * 1, 2)) > 50 Or nRow = UBound(vData) Then
    
13.             nFill = nFill + 1
    
14.             ReDim Preserve vFill(1 To 3, 1 To nFill)
    
15.             vFill(1, nFill) = nStart
    
16.             vFill(2, nFill) = nRow
    
17.             vFill(3, nFill) = nSum
    
18.             
    
19.             nStart = nRow + 1
    
20.             nSum = 0
    
21.         End If
    
22.         nRow = nRow + 1
    
23.     Loop
    
24.     With [E2:G2]
    
25.         .CurrentRegion.Offset(1).ClearContents
    
26.         .Resize(nFill) = Application.Transpose(vFill)
    
27.     End With
    
28. End Sub

复制代码

microyip

附上附件以供参考