AW: Kalenderdaten umwandeln
01.09.2014 17:53:52
fcs
Hallo Christian,
ich hatte erst versucht per Formel dass Ganze aufzulösen, aber um es einigermaßen übersichtlich zu halten braucht es wohl 2 bis 3 Hilfsspalten. Insbesondere der Fall in Zelle A5 (in der Zelle steht eine echtes Datum, das als MMM JJ formatiert ist) bereitet Probleme.
Ich bin dann zu einer VBA-Funktion übergegangen.
Die ist zwar auch nicht einfacher, aber man kann die Sonderfälle "einfacher" abarbeiten"
Gruß
Franz
Function fncDatumUmwandlung(rngDatum As Range) As Variant
Dim intJahr As Integer, intMonat As Integer, intTag As Integer
Dim strTag As String, strMonat As String, strJahr As String, strText As String
Dim iPos As Integer
strText = Trim(rngDatum.Text)
fncDatumUmwandlung = "#Datumsfehler!"
Select Case strText
Case "?", ""
'Texte die nicht konvertiert werden sollen
fncDatumUmwandlung = ""
Case Else
If Len(strText) = 4 And IsNumeric(strText) Then
'nur Jahreszahl steht in Zelle
intJahr = Val(strText)
intMonat = 12
intTag = 31
fncDatumUmwandlung = DateSerial(intJahr, intMonat, intTag)
Else
'Prüfen, ob ein Datum mit nummerischen Angaben in der Zelle steht/angezeigt wird
If strText Like "#.#.##" Or strText Like "##.#.##" Or _
strText Like "#.##.##" Or strText Like "##.##.##" Or _
strText Like "#.#.####" Or strText Like "##.#.####" Or _
strText Like "#.##.####" Or strText Like "##.##.####" Then
If IsDate(strText) Then
fncDatumUmwandlung = CDate(strText)
End If
Else
'Datumstext Zeichenweise verarbeiten
'Nummerische Zeichen am Anfang als Tag interpretieren
For iPos = 1 To Len(strText)
Select Case Asc(Mid(strText, iPos, 1))
Case Asc(0) To Asc(9)
strTag = strTag & Mid(strText, iPos, 1)
Case Else
If strTag = "" Then strTag = "31"
Exit For
End Select
Next
intTag = Val(strTag)
'nach Tag folgenden Text als Monat, Ziffern als Jahr interpretieren
For iPos = iPos To Len(strText)
Select Case Asc(Mid(strText, iPos, 1))
Case Asc(" "), Asc(".") 'Trennzeichen im Datumstext
Case Asc(0) To Asc(9)
strJahr = strJahr & Mid(strText, iPos, 1)
Case Else
strMonat = strMonat & Mid(strText, iPos, 1)
End Select
Next
If Len(strJahr) = 2 Then
strJahr = "20" & strJahr
End If
intJahr = Val(strJahr)
Select Case strMonat
Case "Jan", "Januar", "January", Format(DateSerial(Year(Date), 1, 1), "MMM"), _
Format(DateSerial(Year(Date), 1, 1), "MMMM")
intMonat = 1
Case "Feb", "Februarar", "February", Format(DateSerial(Year(Date), 1, 1), "MMM"), _
Format(DateSerial(Year(Date), 1, 1), "MMMM")
intMonat = 2
Case "Mrz", "März", "Mar", "March", Format(DateSerial(Year(Date), 1, 1), "MMM"), _
Format(DateSerial(Year(Date), 1, 1), "MMMM")
intMonat = 3
Case "Apr", "April", Format(DateSerial(Year(Date), 1, 1), "MMM"), _
Format(DateSerial(Year(Date), 1, 1), "MMMM")
intMonat = 4
Case "Mai", "May", Format(DateSerial(Year(Date), 1, 1), "MMM"), _
Format(DateSerial(Year(Date), 1, 1), "MMMM")
intMonat = 5
Case "Jun", "Juni", "June", Format(DateSerial(Year(Date), 1, 1), "MMM"), _
Format(DateSerial(Year(Date), 1, 1), "MMMM")
intMonat = 6
Case "Jul", "Juli", "July", Format(DateSerial(Year(Date), 1, 1), "MMM"), _
Format(DateSerial(Year(Date), 1, 1), "MMMM")
intMonat = 7
Case "Aug", "August", Format(DateSerial(Year(Date), 1, 1), "MMM"), _
Format(DateSerial(Year(Date), 1, 1), "MMMM")
intMonat = 8
Case "Sep", "September", Format(DateSerial(Year(Date), 1, 1), "MMM"), _
Format(DateSerial(Year(Date), 1, 1), "MMMM")
intMonat = 9
Case "Okt", "Oktober", Format(DateSerial(Year(Date), 1, 1), "MMM"), _
Format(DateSerial(Year(Date), 1, 1), "MMMM"), "Oct", "October"
intMonat = 10
Case "Nov", "November", Format(DateSerial(Year(Date), 1, 1), "MMM"), _
Format(DateSerial(Year(Date), 1, 1), "MMMM")
intMonat = 11
Case "Dez", "Dezember", Format(DateSerial(Year(Date), 1, 1), "MMM"), _
Format(DateSerial(Year(Date), 1, 1), "MMMM"), "Dec", "December"
intMonat = 12
Case Else
Exit Function
End Select
'Ergebnis auf gültiges Datum prüfen
If IsDate(Format(intJahr, "0000") & "-" & Format(intMonat, "00") & "-" _
& Format(intTag, "00")) Then
fncDatumUmwandlung = DateSerial(intJahr, intMonat, intTag)
End If
End If
End If
End Select
End Function