Datumsdifferenz in Jahren, Monaten, Tagen berechnen

12/12/2009 - 10:48 von Andreas Killer | Report spam
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 ÚTEDIF($A1;$B1;"y")
D1 ÚTEDIF($A1;$B1;"ym")
E1 ÚTEDIF($A1;$B1;"md")
F1 ÚTEDIFVBA($A1;$B1;"y")
G1 ÚTEDIFVBA($A1;$B1;"ym")
H1 ÚTEDIFVBA($A1;$B1;"md")

A2 31.07.2002
B2 26.03.2003
C2 ÚTEDIF($A2;$B2;"y")
D2 ÚTEDIF($A2;$B2;"ym")
E2 ÚTEDIF($A2;$B2;"md")
F2 ÚTEDIFVBA($A2;$B2;"y")
G2 ÚTEDIFVBA($A2;$B2;"ym")
H2 ÚTEDIFVBA($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?welcher1
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
 

Lesen sie die antworten

#1 Peter Schleif
12/12/2009 - 13:23 | Warnen spam
Andreas Killer schrieb am 12.12.2009 10:48 Uhr:

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

Vom 30.01.2004 bis 02.03.2004 sind es
0 Jahre 1 Monat, 2 Tage und nicht 0 Jahre 1 Monat, 1 Tage



Weder noch. 3 wàre richtig.


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



Stimmt. 26 ist korrekt.


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



Kannst Du mal diese php-Lösung testen. Ist zwar extrem langsam, aber zum
Testen reicht es. Du müsstest dazu vorübergehend diese beiden php-Files
direkt nach C:\ kopieren:

http://home.arcor.de/peter.schleif/php-win.exe (24 KB)
http://home.arcor.de/peter.schleif/php5ts.dll (5618 KB)

Aufruf: =phpDateDiff("md";$A1;$B1)
erlaubt: y, m, d, md

Function phpDateDiff(interval As String,d1 As Date, d2 As Date)
Static wsh As Object
Dim exe As Object
Dim cmd As String
Dim arr As Variant

Const php = "C:\php-win.exe"

cmd = cmd & "date_default_timezone_set('Europe/Berlin');"
cmd = cmd & "$date = new DateTime('" _
& Format(d2, "YYYY-MM-DD") & "');"
cmd = cmd & "$d = $date->diff(new DateTime('" _
& Format(d1, "YYYY-MM-DD") & "'));"
cmd = cmd & "echo $d->y.'|'.$d->m.'|'.$d->d.'|'.$d->days;"

If wsh Is Nothing Then Set wsh = CreateObject("WScript.Shell")
Set exe = wsh.Exec(php & " -r """ & cmd & """")

arr = Split(exe.StdOut.ReadAll & " ", "|")

If UBound(arr) <> 3 Then
phpDateDiff = "#PHPDATEDIFF!"
Else
Select Case LCase(interval)
Case "y": phpDateDiff = Val(arr(0))
Case "m": phpDateDiff = Val(arr(1))
Case "d": phpDateDiff = Val(arr(2))
Case "md": phpDateDiff = Val(arr(3))
End Select
End If

Set exe = Nothing
End Function

Ähnliche fragen