AW: neuer Upload
22.04.2013 16:08:10
Klaus
Hi,
ich habe keine Idee, warum er bei Kunde "1" die Schleife nicht korrekt durchläuft ...
aber SO sollte es gehen, auch wenn ich nicht verstehe weshalb :-)
Sub OhneFunctionMenge()
Dim iColJahr As Integer
Dim iColMenge As Integer
Dim lRowF As Long
Dim lRowL As Long
Dim l As Long
Dim arrTeil
Dim N As Integer
Dim rFilter As Range
iColMenge = WorksheetFunction.Match("Gesamtmenge der Lieferungen", Range("A5").EntireRow, False) _
iColJahr = WorksheetFunction.Match(Cells(4, iColMenge).Value, Range("A4").EntireRow, False)
lRowF = 6
lRowL = Cells(Rows.Count, 2).End(xlUp).Row
If lRowL = lRowF Then
arrTeil = Split(Cells(lRowF, iColJahr).Value, "-")
For N = 1 To UBound(arrTeil) Step 2
Cells(lRowF, iColMenge).Value = Cells(lRowF, iColMenge).Value + CSng(arrTeil(N))
Next N
Else
For Each rFilter In Range(Cells(lRowF, iColMenge), Cells(lRowL, iColMenge)).SpecialCells( _
xlCellTypeVisible)
'Bei "nix" einen Nullwert eintragen (vorherige Version: löschen)
Cells(rFilter.Row, iColMenge).Value = 0 '.clearcontents
arrTeil = Split(Cells(rFilter.Row, iColJahr).Value, "-")
For N = 1 To UBound(arrTeil) Step 2
Cells(rFilter.Row, iColMenge).Value = Cells(rFilter.Row, iColMenge).Value + CSng( _
arrTeil(N))
Next N
Next rFilter
End If
End Sub