Function DateStrToDateNum()

'DateStrToDateNum wandelt einen DatumsText (TT.MM.JJJJ oder TT.MM.JJ) um
'und gibt einen numerischen Datumswert zurück
 
Function DateStrToDateNum(StrDateToNumDate as String) as Numeric
 
Dim Tag_TT as Numeric = 0
Dim Monat_MM as Numeric = 0
Dim Jahr_JJ as Numeric = 0
Dim Add_J as Numeric = 0
Dim Add_M as Numeric = 0
Dim Add_T as Numeric = 0
Dim Schalt_Tag as Numeric = 0
 
Tag_TT = StringToNumeric(StringLeft(StrDateToNumDate, 2))
Monat_MM = StringToNumeric(StringMid(StrDateToNumDate, 4, 2))
Jahr_JJ = StringToNumeric(StringRight(StrDateToNumDate, 2))
 
if Jahr_JJ = 12 then Add_J = 40908 end if
if Jahr_JJ = 13 then Add_J = 41274 end if
if Jahr_JJ = 14 then Add_J = 41639 end if
if Jahr_JJ = 15 then Add_J = 42004 end if
if Jahr_JJ = 16 then Add_J = 42369 end if
if Jahr_JJ = 17 then Add_J = 42735 end if
if Jahr_JJ = 18 then Add_J = 43100 end if
if Jahr_JJ = 19 then Add_J = 43465 end if
if Jahr_JJ = 20 then Add_J = 43830 end if
 
if Monat_MM = 01 then Add_M = 000 end if
if Monat_MM = 02 then Add_M = 031 end if
if Monat_MM = 03 then Add_M = 059 end if
if Monat_MM = 04 then Add_M = 090 end if
if Monat_MM = 05 then Add_M = 120 end if
if Monat_MM = 06 then Add_M = 151 end if
if Monat_MM = 07 then Add_M = 181 end if
if Monat_MM = 08 then Add_M = 212 end if
if Monat_MM = 09 then Add_M = 243 end if
if Monat_MM = 10 then Add_M = 273 end if
if Monat_MM = 11 then Add_M = 304 end if
if Monat_MM = 12 then Add_M = 334 end if
 
Add_T = Tag_TT
 
if Monat_MM > 02 then
 
if Jahr_JJ = 12 then Schalt_Tag = 1 end if
if Jahr_JJ = 16 then Schalt_Tag = 1 end if
if Jahr_JJ = 20 then Schalt_Tag = 1 end if
end if
 
DateStrToDateNum = Add_J + Add_M + Add_T + Schalt_Tag
 
end function