Option
Explicit
Sub
CheckZahlungen()
Dim
rngBetragAll
As
Range, rngBetrag
As
Range
Dim
rngTerminAll
As
Range, rngTermin
As
Range
Dim
rng
As
Range
Dim
rngRow
As
Range
Dim
dblBetrag(11)
As
Double
With
ThisWorkbook
Set
rngBetragAll = .Names(
"Betrag"
).RefersToRange
Set
rngTerminAll = .Names(
"Zahlungstermin"
).RefersToRange
For
Each
rngRow
In
rngBetragAll.Worksheet.UsedRange.Rows
Set
rngBetrag = Intersect(rngBetragAll, rngRow)
If
Not
IsEmpty(rngBetrag)
Then
For
Each
rngTermin
In
Intersect(rngTerminAll, rngRow).Cells
If
Not
IsEmpty(rngTermin)
Then
If
IsDate(rngTermin)
Then
If
DateDiff(
"d"
, Now, rngTermin) > 0
Then
dblBetrag(DatePart(
"m"
, rngTermin) - 1) = dblBetrag(DatePart(
"m"
, rngTermin) - 1) + rngBetrag.Value
End
If
End
If
Else
Exit
For
End
If
Next
Else
Exit
For
End
If
Next
End
With
Dim
i
As
Integer
Debug.Print
"Anstehende Zahlungen:"
For
i = 0
To
11
If
dblBetrag(i) <> 0
Then
Debug.Print
"Monat "
& Format(DateSerial(2000, i + 1, 1),
"mmmm"
) &
": "
& dblBetrag(i);
" Euro"
End
If
Next
End
Sub