Makro, welches Daten umwandelt
15.11.2014 08:22:07
Christian
ich möchte euch bitten, mir zu helfen nachfolgendes Makro ein wenig abzuändern.
Es geht mir darum, ich benutze das Makro an 2 Stellen in meiner Tabelle. Einmal als Formel =fncDatumUmwandlung(C1) und einmal =fncDatumUmwandlung(G1). Beides in Tabelle2.
In dem Makro steht u.a. ein Mechanismus, der aus einer vierstelligen Zahl ein Datum macht, z.B, aus der Zahl 1963 den 31.12.1963.
Gibt es eine Möglichkeit, dass das Makro unterscheidet, dass wenn sich die Formel auf Spalte G bezieht, das Makro wie gehabt den 31.12. ausgibt, jedoch wenn sie sich auf Spalte C bezieht, den 01.01. ausgibt?
Wenn ja wäre ich euch für Eure Hilfe dankbar.
Gruß
Chris
Function fncDatumUmwandlung(rngDatum As Range) As Variant
Dim iPos As Integer, arrEN, arrDE
arrEN = Array("January", "February", "March", "April", "May", "June", "July", "August", " _
September", "October", "November", "December")
arrDE = Array("Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", " _
September", "Oktober", "November", "Dezember")
strText = Trim(rngDatum.Text)
If Len(strText) = 4 And IsNumeric(strText) Then
fncDatumUmwandlung = DateSerial(--strText, 12, 31)
End If
If fncDatumUmwandlung = "" Then
If IsDate(strText) Then
fncDatumUmwandlung = CDate(strText)
End If
End If
If fncDatumUmwandlung = "" Then
For iPos = 0 To 11
strText = Replace(strText, arrEN(iPos), arrDE(iPos))
Next
If IsDate(strText) Then
fncDatumUmwandlung = CDate(strText)
End If
End If
If fncDatumUmwandlung = "" Then
For iPos = 0 To 11
strText = Replace(strText, Left(arrEN(iPos), 3), arrDE(iPos))
Next
If IsDate(strText) Then
fncDatumUmwandlung = CDate(strText)
End If
End If
Select Case strText
Case Format(fncDatumUmwandlung, "MMM YY"), Format(fncDatumUmwandlung, "MMM YYYY"), _
Format(fncDatumUmwandlung, "MMMM YY"), Format(fncDatumUmwandlung, "MMMM YYYY")
fncDatumUmwandlung = DateSerial(Year(fncDatumUmwandlung), Month(fncDatumUmwandlung) + 1, _
_
0)
End Select
End Function