Datumsdifferenz in Jahren, Monaten, Tagen berechnen

Discussion:

(zu alt für eine Antwort)

Andreas Killer

2009-12-12 09:48:09 UTC

Juhu. :-)

Mir ist da grad was in die Finger gefallen, das wollte ich Euch mal
fragen:

Um z.B. das Alter einer Person zu berechnen wird ja oft die
undokumentierte Funktion DATEDIF genannt. Gerade letztens fragte
jemand nach der Berechnung (ohne VBA) für historische Personen die vor
1900 gelebt haben.

Nun ja, dachte ich, mit VBA wäre das ein Klacks, man könnte ja die
DATEDIF in VBA nachbilden. Geht auch kein Thema, aaaaaaaaaaaber:

DATEDIF rechnet ja gar nicht richtig, wenn man es mit "md", "ym"
aufruft!???!!

Dann habe ich gesucht und gesucht, nicht viel gefunden, alle Lösungen
rechnen falsch:

A1 30.01.2004
B1 02.03.2004
C1 =DATEDIF($A1;$B1;"y")
D1 =DATEDIF($A1;$B1;"ym")
E1 =DATEDIF($A1;$B1;"md")
F1 =DATEDIFVBA($A1;$B1;"y")
G1 =DATEDIFVBA($A1;$B1;"ym")
H1 =DATEDIFVBA($A1;$B1;"md")

A2 31.07.2002
B2 26.03.2003
C2 =DATEDIF($A2;$B2;"y")
D2 =DATEDIF($A2;$B2;"ym")
E2 =DATEDIF($A2;$B2;"md")
F2 =DATEDIFVBA($A2;$B2;"y")
G2 =DATEDIFVBA($A2;$B2;"ym")
H2 =DATEDIFVBA($A2;$B2;"md")

Vom 30.01.2004 bis 02.03.2004 sind es
0 Jahre 1 Monat, 2 Tage und nicht 0 Jahre 1 Monat, 1 Tage
Vom 31.07.2002 bis 26.03.2003 sind es
1 Jahre 7 Monat, 26 Tage und nicht 1 Jahre 7 Monat, 23 Tage

Auch die Formeln auf
http://www.excelformeln.de/formeln.html?welcher=141
liefern das gleiche falsche Ergebnis.

Gibt es da eine VBA-Lösung die (für alle Excel-Versionen) richtig rechnet?

Andreas.

#Const Version = 1

Function DateDifVBA(ByVal Datum1 As Date, ByVal Datum2 As Date, _
ByVal Zeiteinheit As String) As Long
'Die DATEDIF-Funktion auch für Daten vor 1900
'Zeiteinheit:
'y Anzahl kompletter Jahre
'm Anzahl kompletter Monate
'd Anzahl der Tage
'md Unterschied in Tagen, wobei Monate und Jahre ignoriert _
werden
'ym Unterschied in Monaten, Tage und Jahre bleiben _
unberücksichtigt
'yd Unterschied in Tagen, wobei die Jahre ignoriert werden
#If Version = 1 Then
Dim I As Integer
Zeiteinheit = LCase(Left(Zeiteinheit, 2))
For I = 1 To Len(Zeiteinheit)
Select Case Mid(Zeiteinheit, I, 1)
Case "y"
DateDifVBA = DateDiff("yyyy", Datum1, Datum2, _
vbUseSystemDayOfWeek, vbUseSystem)
If Datum1 > DateSerial(Year(Datum1), Month(Datum2), _
Day(Datum2)) Then DateDifVBA = DateDifVBA - 1
Datum1 = DateSerial(Year(Datum1) + DateDifVBA, Month( _
Datum1), Day(Datum1))
Case "m"
DateDifVBA = DateDiff("m", Datum1, Datum2, _
vbUseSystemDayOfWeek, vbUseSystem)
If Datum1 > DateSerial(Year(Datum1), Month(Datum1), _
Day(Datum2)) Then DateDifVBA = DateDifVBA - 1
Datum1 = DateSerial(Year(Datum1), Month(Datum1) + _
DateDifVBA, Day(Datum1))
Case "d"
DateDifVBA = DateDiff("d", Datum1, Datum2, _
vbUseSystemDayOfWeek, vbUseSystem)
End Select
Next
#End If

#If Version = 2 Then
Dim Day1 As Integer, Day2 As Integer, Days As Integer
Dim Month1 As Integer, Month2 As Integer, Months As Integer
Dim Year1 As Integer, Year2 As Integer, Years As Integer

Date2DMY Datum1, Day1, Month1, Year1
Date2DMY Datum2, Day2, Month2, Year2

'{days first}
If Day1 > Day2 Then
Month2 = Month2 - 1
If Month2 = 0 Then
Month2 = 12
Year2 = Year2 - 1
End If
Day2 = Day2 + DaysInMonth(DateSerial(Year2, Month2, 1))
End If
Days = Day2 - Day1

'{now months and years}
If Month1 > Month2 Then
Month2 = Month2 + 12
Year2 = Year2 - 1
End If
Months = Month2 - Month1
Years = Year2 - Year1

Zeiteinheit = LCase(Left(Zeiteinheit, 2))

Select Case Zeiteinheit
Case "y"
DateDifVBA = Years
Case "m"
DateDifVBA = Years * 12 + Months
Case "d"
DateDifVBA = DateDiff("d", Datum1, Datum2, _
vbUseSystemDayOfWeek, vbUseSystem)
Case "ym"
DateDifVBA = Months
Case "md"
DateDifVBA = Days
End Select
#End If
End Function

#If Version = 2 Then
Sub Date2DMY(ByVal Datum As Date, ByRef Tag, ByRef Monat, _
ByRef Jahr)
'Wandelt ein Datum in Tag, Monat, Jahr
Tag = Day(Datum)
Monat = Month(Datum)
Jahr = Year(Datum)
End Sub

Function DaysInMonth(ByVal Datum As Date) As Integer
'Liefert die Anzahl der Tage des Monats in dem Datum liegt
DaysInMonth = Day(DateSerial(Year(Datum), Month(Datum) + 1, _
1) - 1)
End Function
#End If

Peter Schleif

2009-12-12 12:23:48 UTC