Function Datum Speziel
04.04.2006 11:47:45
Gerhard
suche eine
Function die mir das Spezial-datumsformat "KW.WochenTag/Jahr" wieder in das Datumsformat "DD/MM/JJ zurückschreibt!
Beispiel: 24.3/06 = Kalenderwoche.Wochentag (1 = Montag)/Jahr => 14.06.06
Die
Function die das gängige Datumsformat, z. B. "14.06.06", in das Spezialformart "14.3/06" umwandelt lautet:
Function KW_Spezial(datum As Date) As String
Dim KW As Long
Dim Jahr As Long
Dim WoTag As Long
Dim Wert As Double
Wert = DateSerial(Year(datum + (8 - Weekday(datum)) Mod 7 - 3), 1, 1)
KW = (datum - Wert - 3 + (Weekday(Wert) + 1) Mod 7) \ 7 + 1
WoTag = Weekday(datum, vbMonday)
Jahr = Year(datum)
If Month(datum) = 1 And KW > 51 Then
Jahr = Jahr - 1
ElseIf Month(datum) = 12 And KW < 2 Then
Jahr = Jahr + 1
End If
KW_Spezial = Format(KW, "00") & "." & WoTag & "/" & Right(CStr(Jahr), 2)
End Function
Sub Datum_formatieren()
ActiveCell.Value = KW_Spezial(ActiveCell.Value)
End Sub
Vielen Dank für Eure Bemühungen!
Gerhard