Option
Explicit
Dim
Spalte
As
Long
, Grenzwert
As
Double
, dKum
As
Double
, arrRng()
As
Variant
Sub
aTest()
Spalte = 1: Grenzwert = 20
Columns(Spalte).Offset(, 1).Resize(, 2).Clear
aKumu 1
End
Sub
Sub
aKumu(Start
As
Long
)
Dim
x
As
Long
, y
As
Long
Dim
Rng
As
Range
With
Columns(Spalte)
Set
Rng = .Range(.Cells(Start), .Cells(.Cells.Count).
End
(xlUp)).Resize(, 3)
arrRng = Rng.Value
For
x = LBound(arrRng, 1)
To
UBound(arrRng, 1)
If
IsNumeric(arrRng(x, 1))
And
arrRng(x, 1) >= Grenzwert
Then
arrRng(x, 2) = Grenzwert
arrRng(x, 3) = arrRng(x, 2) - Grenzwert
Else
If
IsNumeric(arrRng(x, 1))
Then
y = aKumIt(x, arrRng(x, 1))
If
y <= UBound(arrRng, 1)
Then
arrRng(y, 2) = Grenzwert
arrRng(y, 3) = dKum - Grenzwert
dKum = 0
x = y
Else
Exit
For
End
If
End
If
End
If
Next
x
.Cells(1).Resize(UBound(arrRng, 1), UBound(arrRng, 2)).Value = arrRng
End
With
End
Sub
Function
aKumIt(Rw
As
Long
,
ByVal
Wert
As
Double
)
As
Long
Dim
x
As
Long
, Kum
As
Double
Kum = Kum + Wert
For
x = Rw + 1
To
UBound(arrRng, 1)
If
IsNumeric(arrRng(x, 1))
Then
_
Kum = Kum + arrRng(x, 1)
If
Kum >= Grenzwert
Then
Exit
For
Next
x
dKum = Kum
aKumIt = x
End
Function