gesucht: Funktion, Makro oder Formel - haarig!
18.07.2003 09:31:30
Martin
ich habe mich bei folgendem Problem komplett festgefahren und komme nicht mehr raus.
Eine Tabelle erfasst Daten, die im wesentlichen aus einem Code (nennen wir ihn Kauf) und einem Datum bestehen. Das Datum ist dasjenige, an dem der Kauf getätigt wurde. Relevant ist das Datum, um die Fälligkeit des Kaufes zu erkennen.
Die Fälligkeit ist ihrerseits abhängig davon, welche Art von Kauf vorliegt. Unterschieden wird zwischen einem CF- und einem FF-Kauf. CF hat eine Fälligkeit von 3 Tagen, FF von 5 Tagen.
Das heisst, dass ein FF mit Datum 15/07/03 am 22/07/03 fällig wird, da die Wochenenden aus der Berechnung ausgeschlossen werden (15/07/03 + 5 Tage = 20/07/03 - WE wird aber übersprungen - also 22/07/03).
Was ich hinzufügen möchte, ist eine Spalte, in der ich entweder das Fälligkeitsdatum oder aber die restlichen Tage bis zur Fälligkeit anzeigen lasse. Die Formel oder die Funktion oder das Makro muss also in Abhängigkeit der Kaufart (CF, FF) und des Datums die Berechnung durchführen, zugleich aber die Wochenden ausklammern und das ist das Problem.
Folgendes Makro habe ich gebastelt, um (als Krücke) mir die Tage rund um die Fälligkeit anzeigen zu lassen. Es werden also hier bereits die WE ausgeklammert. Vielleicht ist dies eine Hilfe.
Sub FixDate()
Dim dT2p As Range
Dim dT1p As Range
Dim dtoday As Range
Dim dT1 As Range
Dim dT2 As Range
Dim dT3 As Range
Dim dT4 As Range
Dim dT5 As Range
Dim dT6 As Range
Dim dT7 As Range
Set dT2p = Sheets("Datum").Range("dT_2p") 'today +2
Set dT1p = Sheets("Datum").Range("dT_1p") 'today +1
Set dtoday = Sheets("Datum").Range("dT") 'today
Set dT1 = Sheets("Datum").Range("dT_1") 'yesterday
Set dT2 = Sheets("Datum").Range("dT_2") 'day before yesterday
Set dT3 = Sheets("Datum").Range("dT_3") '...
Set dT4 = Sheets("Datum").Range("dT_4")
Set dT5 = Sheets("Datum").Range("dT_5")
Set dT6 = Sheets("Datum").Range("dT_6")
Set dT7 = Sheets("Datum").Range("dT_7")
If Weekday(Date) = 2 Then '=Monday
heuer2p = DateValue(Format(Date + 2)) 'Wed
heuer1p = DateValue(Format(Date + 1)) 'Tue
heuer1 = DateValue(Format(Date - 3)) 'Fri
heuer2 = DateValue(Format(Date - 4)) 'Thu
heuer3 = DateValue(Format(Date - 5)) 'Wed
heuer4 = DateValue(Format(Date - 6)) 'Tue
heuer5 = DateValue(Format(Date - 7)) 'Mon
heuer6 = DateValue(Format(Date - 10)) 'Fri
heuer7 = DateValue(Format(Date - 11)) 'Thu
ElseIf Weekday(Date) = 3 Then 'Tue
heuer2p = DateValue(Format(Date + 2)) 'Thu
heuer1p = DateValue(Format(Date + 1)) 'Wed
heuer1 = DateValue(Format(Date - 1)) 'Mon
heuer2 = DateValue(Format(Date - 4)) 'Fri
heuer3 = DateValue(Format(Date - 5)) 'Thu
heuer4 = DateValue(Format(Date - 6)) 'Wed
heuer5 = DateValue(Format(Date - 7)) 'Tue
heuer6 = DateValue(Format(Date - 8)) 'Mon
heuer7 = DateValue(Format(Date - 11)) 'Fri
ElseIf Weekday(Date) = 4 Then 'Wed
heuer2p = DateValue(Format(Date + 2)) 'Fri
heuer1p = DateValue(Format(Date + 1)) 'Thu
heuer1 = DateValue(Format(Date - 1)) 'Tue
heuer2 = DateValue(Format(Date - 2)) 'Mon
heuer3 = DateValue(Format(Date - 5)) 'Fri
heuer4 = DateValue(Format(Date - 6)) 'Thu
heuer5 = DateValue(Format(Date - 7)) 'Wed
heuer6 = DateValue(Format(Date - 8)) 'Tue
heuer7 = DateValue(Format(Date - 9)) 'Mon
ElseIf Weekday(Date) = 5 Then 'Thu
heuer2p = DateValue(Format(Date + 4)) 'Mon
heuer1p = DateValue(Format(Date + 1)) 'Fri
heuer1 = DateValue(Format(Date - 1)) 'Wed
heuer2 = DateValue(Format(Date - 2)) 'Tue
heuer3 = DateValue(Format(Date - 3)) 'Mon
heuer4 = DateValue(Format(Date - 6)) 'Fri
heuer5 = DateValue(Format(Date - 7)) 'Thu
heuer6 = DateValue(Format(Date - 8)) 'Wed
heuer7 = DateValue(Format(Date - 9)) 'Tue
ElseIf Weekday(Date) = 6 Then 'Fri
heuer2p = DateValue(Format(Date + 4)) 'Tue
heuer1p = DateValue(Format(Date + 3)) 'Mon
heuer1 = DateValue(Format(Date - 1)) 'Thu
heuer2 = DateValue(Format(Date - 2)) 'Wed
heuer3 = DateValue(Format(Date - 3)) 'Tue
heuer4 = DateValue(Format(Date - 4)) 'Mon
heuer5 = DateValue(Format(Date - 7)) 'Fri
heuer6 = DateValue(Format(Date - 8)) 'Thu
heuer7 = DateValue(Format(Date - 9)) 'Wed
End If
dT2p.Value = CDbl(DateValue(heuer2p))
dT1p.Value = CDbl(DateValue(heuer1p))
dtoday.Value = CDbl(DateValue(Date))
dT1.Value = CDbl(DateValue(heuer1))
dT2.Value = CDbl(DateValue(heuer2))
dT3.Value = CDbl(DateValue(heuer3))
dT4.Value = CDbl(DateValue(heuer4))
dT5.Value = CDbl(DateValue(heuer5))
dT6.Value = CDbl(DateValue(heuer6))
dT7.Value = CDbl(DateValue(heuer7))
End Sub
Ich hoffe das Problem einigermassen verständlich erklärt zu haben und würde mich über eine Lösung oder einen Denkansatz sehr freuen.
Gruss,
Martin