VBA - Do L oop (вложенный)

Question

Я пишу макрос, который разбивает записи на отдельные партии, когда сумма в долларах достигает 1 миллиарда.

Значения рабочей книги

Values:
A1: 450M 
A2: 450M
A3: 400M
A4: 400M
A5: 100M
A6: 300M
*continue until end of range*

Для F1 и F2 они будут частью партии 1. Для ячеек F3: F5 они будут в партии 2. F6 разбивается на новая партия.

Желаемые результаты:

A1: 450M; B1: Batch 1
A2: 450M; B2: Batch 1
A3: 400M; B3: Batch 2
A4: 400M; B4: Batch 2
A5: 100M; B5: Batch 2
A6: 300M; B6: Batch 3
*continue until end of range*

Какой VBA L oop мне использовать для этого?

Sub Determine_Batches()
    Dim Ws As Worksheet
    Dim vDB, vR(), vS() 'vDB will be the Row Count while vR() will be the array?
    Dim i As Long, n As Long
    Dim Cnt As Long 'This inserts the row we're working on into the array
    Dim TotalDrCr As Currency

    Set Ws = ActiveSheet
    With Ws
        'Get the Count of Cells we're reviewing
        vDB = .Range("I2", .Range("I" & Rows.Count).End(xlUp))
        'Debug.Print vDB
    End With

    n = UBound(vDB, 1) 'Declare the Upperbound -> vDB= Ending Row , 1= Starting Row
    ReDim vR(1 To n, 1 To 1) 'The Array that will hold the Batch #'s on each row
    ReDim vS(1 To n, 1 To 1) 'The Array that will show us the Running Total's on each row
        vR(1, 1) = "Batch 1" 'This declares the starting Batch # - This would be a place to obtain the first batch # from Accounting

    'Declarations
        i = 1 'Declare the starting Row and populate values
        Cnt = 1 'This declares the start of the count
        TotalDrCr = vDB(1, 1) 'This declares the sum
        vR(i, 1) = "Batch " & Cnt '-> I found this needed to be added as J2 wasn't being populated
        vS(i, 1) = TotalDrCr

        'Track in the immediate window
        Debug.Print "J" & i & "-" & vR(i, 1) & "-" & TotalDrCr & "-" & vS(i, 1)

    'The all powerful loop
    For i = 2 To n
        'Change the Batch Count to Manual Split out
        'This isn't working, probably because of the above
        If vDB(i, 1) > 10 ^ 9 Then
        vR(i, 1) = "Manual"
        End If

        TotalDrCr = TotalDrCr + vDB(i, 1) 'Get the Total Debit and Credit Amount
        If TotalDrCr > 500000000 Then ' Condition to meet to add +1 to the batch, moving us forward
           Cnt = Cnt + 1 'Move the counter forward
           TotalDrCr = vDB(i, 1) 'this inserts the total
           vR(i, 1) = "Batch " & Cnt 'Add +1 to the batch # if DrCr sum exceeds 1 billion
           vS(i, 1) = TotalDrCr
        ElseIf TotalDrCr < 10 ^ 9 Then
            vS(i, 1) = TotalDrCr
        End If

        vR(i, 1) = "Batch " & Cnt 'Commit the cell and batch # to the array
            Debug.Print "J" & i & "-" & vR(i, 1) & "-" & TotalDrCr & "-" & vS(i, 1)
    Next i

    'This prints out the results of the array to our worksheet
    Ws.Range("J2").Resize(n) = vR 'Print out the array to J2 to n/ or end of the range
    Ws.Range("K2").Resize(n) = vS
End Sub

Answer 1

Попробуйте

Sub test()

    Dim Ws As Worksheet
    Dim vDB, vR()
    Dim i As Long, n As Long
    Dim Cnt As Long
    Dim Total As Currency

    Set Ws = ActiveSheet
    With Ws
        vDB = .Range("a1", .Range("a" & Rows.Count).End(xlUp))
    End With

    n = UBound(vDB, 1)
    ReDim vR(1 To n, 1 To 1)

    vR(1, 1) = "Batch 1"
    Total = vDB(1, 1)
    Cnt = 1
    For i = 2 To n
        Total = Total + vDB(i, 1)
        If Total > 10 ^ 9 Then
           Cnt = Cnt + 1
           Total = vDB(i, 1)
           vR(i, 1) = "Batch " & Cnt
        End If
        vR(i, 1) = "Batch " & Cnt
    Next i

    Ws.Range("b1").Resize(n) = vR
End Sub