Sub rst()
'Tabelle sortiert - ohne Leerzeilen!
Dim c As Range, fa As String
Dim k As Range, e As Range
Dim b As Double, s As Double
Dim z As Range, w As Double
With Columns(1)
Set e = .Cells(.Rows.Count).End(xlUp).Offset(1)
e.Value = "B"
Set c = .Find("B", .Cells(.Rows.Count), -4163, 1, 2, 1, True)
If Not c Is Nothing Then
fa = c.Address
Do
On Error Resume Next
w = z.Value
On Error GoTo 0
b = w + c.Offset(, 1).Value
Set k = c.Offset(1)
If k.Value = "S" Then
s = b
Do While k.Value = "S"
s = s - Abs(k.Offset(, 1).Value)
If s <= 0 Or k.Offset(1).Value = "B" Then
Set z = c.Offset(, 3)
z.Value = s
c.Offset(, 4).Value = k.Offset(, 2).Value
Exit Do
End If
Set k = k.Offset(1)
Loop
Else
Set z = c.Offset(, 3)
z.Value = b
z.Offset(, 1).Value = c.Offset(, 2).Value
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> fa
End If
Rows(e.Row).Clear
End With
End Sub
|