|
Moin,
immer noch Quick&Dirty, dafür nehme ich auch nur 199 Karma-Punkte, aber
selbstplaudernd auf Typenunverträglichkeit getrimmt
Option Explicit
Dim Spalte As Long, Grenzwert As Double, dKum As Double
Sub Test()
Spalte = 1: Grenzwert = 20
'lösche Ergebnisspalten rechts von
Columns(Spalte).Offset(, 1).Resize(, 2).Clear
'ab Zeile 1
Kumu 1
End Sub
Sub Kumu(Start As Long)
Dim x As Long, y As Long
With Columns(Spalte)
For x = Start To .Cells(.Cells.Count).End(xlUp).Row
If IsNumeric(.Cells(x).Value) And .Cells(x).Value >= Grenzwert Then
.Cells(x).Offset(, 1).Value = Grenzwert
'falls erste Zelle bereits größer Grenzwert
.Cells(x).Offset(, 2).Value = .Cells(x).Value - Grenzwert
Else
If IsNumeric(.Cells(x).Value) Then
y = KumIt(x, .Cells(x).Value)
.Cells(y).Offset(, 1).Value = Grenzwert
.Cells(y).Offset(, 2).Value = dKum - Grenzwert
dKum = 0
x = y
End If
End If
Next x
End With
End Sub
Function KumIt(Rw As Long, Wert As Double) As Long
Dim x As Long, Kum As Double
With Columns(Spalte)
Kum = Kum + Wert
For x = Rw + 1 To .Cells(.Cells.Count).End(xlUp).Row
If IsNumeric(.Cells(x).Value) Then _
Kum = Kum + .Cells(x).Value
If Kum >= Grenzwert Then Exit For
Next x
dKum = Kum
KumIt = x
End With
End Function
|