Excel VBA, soma até determinado valor

[Arthur Solly]

Gostaria de desenvolver uma fórmula onde em uma determinada coluna eu somo seus valores até um valor definido, chegando nesse valor abre se uma linha com o valor total e os itens acima que deram esse valor. Feito isso essa conta se repete por toda a coluna até que ela seja finalizada.

Sub DIVIDIR()

Dim C As Variant

Dim I, AUX, AUX1, AUX2, AUX3 As Long

Dim v1, v2, v3, v4, v5 As Currency

AUX = 0

I = 0

If Planilha3.Range("H2").Value > 0 Then

For Each C In Planilha3.Range("D2:D" & Planilha3.Range("D65536").End(xlUp).Row)

v1 = v1 + C.Value

If v1 > Planilha3.Range("H2").Value Then

AUX = v1 - Planilha3.Range("H2").Value

I = C.Row + 1

v1 = Planilha3.Range("H2").Value

v2 = AUX

Exit For

End If

Next C

[d65000].End(xlUp).Offset(1, 0).Value = v1
[d65000].End(xlUp).Offset(0, -1).Value = "DIA 1"

If I > 0 And I <= Planilha3.Range("D65536").End(xlUp).Row Then

For Each C In Planilha3.Range("D" & I & ":D" & Planilha3.Range("D65536").End(xlUp).Row)

v2 = v2 + C.Value

If v2 > Planilha3.Range("H2").Value Then

AUX = v2 - Planilha3.Range("H2").Value

I = C.Row + 1

v2 = Planilha3.Range("H2").Value

v3 = AUX1

Exit For

End If

Next C

[d65000].End(xlUp).Offset(1, 0).Value = v2
[d65000].End(xlUp).Offset(0, -1).Value = "DIA 2"

If I > 0 And I <= Planilha3.Range("D65536").End(xlUp).Row Then

For Each C In Planilha3.Range("D" & I & ":D" & Planilha3.Range("D65536").End(xlUp).Row)

v3 = v3 + C.Value

If v3 > Planilha3.Range("H2").Value Then

AUX = v3 - Planilha3.Range("H2").Value

I = C.Row + 1

v3 = Planilha3.Range("H2").Value

v4 = AUX2

Exit For

End If

Next C

[d65000].End(xlUp).Offset(1, 0).Value = v3
[d65000].End(xlUp).Offset(0, -1).Value = "DIA 3"

If I > 0 And I <= Planilha3.Range("D65536").End(xlUp).Row Then

For Each C In Planilha3.Range("D" & I & ":D" & Planilha3.Range("D65536").End(xlUp).Row)

v4 = v4 + C.Value

If v4 > Planilha3.Range("H2").Value Then

AUX = v4 - Planilha3.Range("H2").Value

I = C.Row + 1

v4 = Planilha3.Range("H2").Value

v5 = AUX3

Exit For

End If

Next C

[d65000].End(xlUp).Offset(1, 0).Value = v4
[d65000].End(xlUp).Offset(0, -1).Value = "DIA 4"

End If

End If

End If

End If

End Sub

 

Cheguei até aqui.

[Valteson]

Boa tarde! Consegui fazer essa mesma tarefa com menos linhas. O código conta da linha 1 a linha n, enquanto forem diferente de vazio.

Segue o código:

Sub CONTAR()

Dim CONT As Double
Dim limite As Double


Range("A1").Select
CONT = 0
limite = 100

Do While ActiveCell <> ""

    Do While CONT < limite
    If ActiveCell.Value = "" Then
    ActiveCell.Value = CONT
    ActiveCell.Interior.Color = vbRed
    End
    
    Else
    CONT = CONT + ActiveCell.Value
    ActiveCell.Offset(1, 0).Activate
    End If
    
    Loop
       
    CONT = CONT - ActiveCell.Offset(-1, 0).Value
    ActiveCell.Offset(-1, 0).Activate
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Value = CONT
    ActiveCell.Interior.Color = vbRed
    ActiveCell.Offset(1, 0).Activate
    CONT = 0
    
Loop
 
End Sub

 

[CasaDoHardware]

Não entendi bem.

 

você tem uma lista e nesta lista você vai somando os valores ate atingir/ultrapassar o valor estipulado e neste posto insere uma linha e coloca este total.

 

O que acontece depois é que nao entendi,

O codigo continua ate a ultima linha repetindo o processo ou para ali?

Se posstar um exemplo da sua planilha e do resultado esperado fica bem fácil obter ajuda.

Spoiler