Guten Morgen zusammen!
Ich hab folgendes Problem: Für diverse Berechnungen brauche ich die Funktion EDATUM. Dafür muß ich das Standard-AddIn "Analyse Funktionen" einbinden bzw. es muß von der Office-CD installiert sein.
Das Programm wird an verschiedene Berater geschickt, leider hat nicht jeder dieses AddIn "physikalisch" installiert.
Ich würde jetzt gerne ein Modul schreiben, dass die EDATUM-Funktion nachbildet, so dass ich diese nicht einbinden muss und jeder meine Funktion benutzen kann.
Wer weiß Rat? Hat sowas schonmal jemand vor mir erledigt?
Gruß
Dennis

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Funktion "EDATUM" in VBA nachcoden!

Matthias
Das wars schon?

Dennis
Ich denke das ist es nicht

Jörg
AW: Du hast recht - schade - o.T.

Matthias
AW: Du hast recht - schade - o.T.

Matthias
Nee, so gehts auch nicht!

Dennis
AW: Nee, so gehts auch nicht!

Jörg
Warum kommt hier ein Compiler-Fehler?

Dennis
PS:

Dennis
Noch offen o.T.

Matthias
Ich habs, das ist die Lösung! EDATUM nachgecodet

Dennis
Teamwork war sehr lehrreich. Danke o.T.

Jörg

AW: Funktion "EDATUM" in VBA nachcoden!

Matthias

Hallo Dennis,


Function EDat(d As Date, m As Integer) As Date
EDat = DateSerial(Year(d), Month(d) + m, Day(d))
End Function

Gruß Matthias

Das wars schon?

19.04.2004 09:38:33

Dennis

Hallo Matthias,
was, das wars schon? Wahnsinn, vielen Dank, das funktioniert wunderbar! Jetz hab ich so einiges an Problemen gelöst.
Gruß
Dennis

Ich denke das ist es nicht

Jörg

Hallo Matthias,
in A1 den 31.03.04
=DATUM(JAHR(A1);MONAT(A1)-1;TAG(A1)) ergibt den 02.03.04
=EDATUM(A1;-1) ergibt richtig den 29.02.04
Leider bleibt Excel nicht im Monat und zeigt den Monatsletzten an, sondern zählt die verbleibenden Tage obendrauf!
Gruss Jörg

AW: Du hast recht - schade - o.T.

Matthias

AW: Du hast recht - schade - o.T.

Matthias

Hallo Jörg,
aber so vielleicht:


Function EDat(d As Date, m As Integer) As Date
Dim d0 As Date
d0 = CDate(DateSerial(Year(d), Month(d) + m, Day(d)))
If Month(d0) <> (Month(d) + m) Mod 12 Then d0 = d0 - Day(d0)
EDat = d0
End Function

Gruß Matthias

Nee, so gehts auch nicht!

Dennis

Hallo,
Matthias, Deine Funktion:


Function EDat(d As Date, m As Integer) As Date
Dim d0 As Date
d0 = CDate(DateSerial(Year(d), Month(d) + m, Day(d)))
If Month(d0) <> (Month(d) + m) Mod 12 Then d0 = d0 - Day(d0)
EDat = d0
End Function

In A1: 31.12.04
Deine Funktion mit -3 Monaten liefert 30.11.03, edatum liefert richtig 31.12.03!
Schade, ich dachte erst, Deine Funktion würde funktionieren.
Hast Du vielleicht noch eine andere Idee?
Dennis

AW: Nee, so gehts auch nicht!

Jörg

Hallo Dennis,
ich habe hier was gefunden
http://www.excelformeln.de/formeln.html?welcher=6
vielleicht ist Matthias so freundlich daraus eine VBA Funktion zu schreiben, dafür reichen meine VBA Kenntnisse nämlich nicht aus.
Gruss Jörg

Warum kommt hier ein Compiler-Fehler?

19.04.2004 10:58:21

Dennis

Also ich habe die Beispielfunktion von http://www.excelformeln.de/formeln.html?welcher=6 (ganz unten) mal in VBA übernommen. Aber warum kommt hier die Fehlermeldung "


Sub oder 

Function nicht definiert" und zwar bei der Stelle "Min" ?

Function EDat(d As Date, m As Integer) As Date
EDat = DateSerial(Year(d), Month(d) + m, Min(Day(d), Day(DateSerial(Year(d), 1 + Month(d) + m, 0))))
End Function


Dennis

PS:

19.04.2004 11:03:03

Dennis

PS:
Die für EDATUM in VBA nachzubildene Formel lautet:
Wobei A1: Ausgangsdatum, D2: Anzahl Monate (In Funktion mit den Variablen d und m zu ersetzen)
=DATUM(JAHR(A1);MONAT(A1)+D2;MIN(TAG(A1);TAG(DATUM(JAHR(A1);1+MONAT(A1)+D2;))))
Die Formel funktioniert genau wie EDATUM, muß aber jetzt in ein VBA-Modul.
Das muß doch machbar sein! (Leider nicht von mir ;) )
Dennis

Noch offen o.T.

Matthias

Ich habs, das ist die Lösung! EDATUM nachgecodet

Dennis

Hi,
ich hab jetzt endlich die Lösung. Das so etwas nie jemand vor mir gebraucht hat finde ich schon komisch. Hier ist der Code:


Function EDat(d As Date, m As Integer) As Date
EDat = DateSerial(Year(d), Month(d) + m, Application.WorksheetFunction.Min(Day(d), Day(DateSerial(Year(d), 1 + Month(d) + m, 0))))
End Function

Schöne Grüße
Dennis

Teamwork war sehr lehrreich. Danke o.T.

Jörg