une fonction qui renvoie parfois une date erronée

Magic_Doctor

XLDnaute Barbatruc
Bonsoir,

J'ai rédigé une petite fonction me permettant de récupérer la même date (jour et mois) des années après une date donnée, mais sous certaines conditions.
Il y a 2 dates "stratégiques" : le premier janvier et le dernier jour du mois de février.
La fonction s'appelle : DateSortie ---> DateSortie(madate As Date, nbyears As Byte)
Exemples :
DateSortie(15 mars 2004, 6) <=> 6 ans après le 15 mars 2004 --> 15 mars 2010
Dates "stratégiques" :
1/ 1er janvier : DateSortie(1er janvier 2004, 6) <=> 6 ans après le 1 janvier 2004 --> 31 décembre 2009
2/ dernier jour du mois de février :
a) c'est un 28 : DateSortie(28 février 2004, 6) <=> 6 ans après le 28 février 2004 --> 28 février 2010
b) c'est un 29 : DateSortie(29 février 2004, 6) <=> 6 ans après le 29 février 2004 --> 28 février 2010 (2004 est une année bissextile et pas 2010)
c'est toujours un 29 : DateSortie(29 février 2004, 8) <=> 8 ans après le 29 février 2004 --> 29 février 2012 (2012 est encore une année bissextile)

La fonction :
VB:
Function DateSortie2(madate As Date, nbyears As Byte) As Date
'Renvoie la date correspondant à une date donnée + un nombre d'années donné.
'Si la date de départ commence un 1er janvier, la date résultante s'achèvera le 31/12 de l'année [a + duration - 1]
'Magic_Doctor
    Dim j As Byte, m As Byte, a As Integer, x As Byte
    j = Day(madate): m = Month(madate): a = Year(madate)
    If j = 1 And m = 1 Then 'la 1ère annuité sera complète (non proratisée)
        j = 31: m = 12: x = 1 '31 décembre
    ElseIf j = 29 And m = 2 Then 'dernier jour de février d'une année bissextile
        j = IIf(IsBissextile(madate) = True, 29, 28)
    End If
    DateSortie2 = CDate(j & "/" & m & "/" & a + nbyears - x)
End Function
Pour gérer les années bissextiles j'ai rédigé ceci :
VB:
Function IsBissextile(fecha As Date) As Boolean
'Vérifie si, dans une date, l'années est bissextile ou pas (tient compte des années théoriquement bissextiles et qui ne le sont en fait pas, ex. 1900 / 2100...)
    If Year(fecha) Mod 4 = 0 And Year(fecha) Mod 100 = 0 And Year(fecha) Mod 400 = 0 Then
        IsBissextile = True
    ElseIf Year(fecha) Mod 4 = 0 And Year(fecha) Mod 100 = 0 And Year(fecha) Mod 400 <> 0 Then
        IsBissextile = False
    ElseIf Year(fecha) Mod 4 = 0 Then
        IsBissextile = True
    End If
End Function
Et bien, contre toute attente, ça plante mais uniquement quand on choisit un 29 février et que le le nombre d'années rajoutées ne soit pas un multiple de 4, autrement dit quand on ne tombe pas sur une année bissextile.

Si parmi vous quelqu'un pouvait m'aider à solutionner ce problème.
Merci d'avance.
 
Dernière édition:

Modeste geedee

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Bonsour®
il faut savoir à quel jour tu veux faire correspondre le 29 février dans le cas des années non bissextille : 28-2 ou 1-03 ?
dans tout les autres cas il est facile de dire : date(année(a1)+X; mois(a1); jour(a1))
 

Magic_Doctor

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Bonsoir Modeste geedee,

Dans mon exemple, ainsi que dans la fonction, je précise bien qu'au 29 février correspondra, si l'année n'est pas bissextile, le 28 février. Après tout cela me semble logique, on ne quitte pas le mois de février.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Bonsoir.
À priori je dirais comme ça:
VB:
Function DateSortie2(MaDate As Date, NbYears As Byte) As Date
'Renvoie la date correspondant à une date donnée + un nombre d'années donné.
'Si la date de départ commence un 1er janvier, la date résultante s'achèvera le 31/12 de l'année [a + duration - 1]
'Magic_Doctor
Dim J As Integer, M As Integer, A As Integer
J = Day(MaDate): M = Month(MaDate): A = Year(MaDate)
DateSortie2 = DateSerial(A + NbYears, M, J)
If J = 1 And M = 1 Or Month(DateSortie2) <> M Then DateSortie2 = DateSortie2 - 1
End Function
À tester…

Oups ! J'ai sauté une instruction. C'est corrigé.
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Bonsoir à tous.


Quelques autres :​
  • VB:
    Function DateSortie3(MaDate As Date, NbAnnées%) As Date
        DateSortie3 = DateSerial(Year(MaDate) + NbAnnées, Month(MaDate), Day(MaDate)) _
            + (Not LeapYear(Year(MaDate) + NbAnnées)) * (Month(MaDate) = 2) * (Day(MaDate) = 29)
    End Function
    
    Function LeapYear(a%) As Boolean
        LeapYear = ((a Mod 4) = 0) * (1 + ((a Mod 100) = 0) * (1 + (((a \ 100) Mod 4) = 0)))
    End Function
    ou
    VB:
    Function DateSortie3bis(MaDate As Date, NbAnnées%) As Date
        DateSortie3bis = DateSerial(Year(MaDate) + NbAnnées, Month(MaDate), Day(MaDate)) _
            - (1 + (((Year(MaDate) + NbAnnées) Mod 4) = 0) * (1 + (((Year(MaDate) + NbAnnées) Mod 100) = 0) * (1 + ((((Year(MaDate) + NbAnnées) \ 100) Mod 4) = 0)))) _
            * (Month(MaDate) = 2) * (Day(MaDate) = 29)
    End Function
  • VB:
    Function DateSortie4(MaDate As Date, NbAnnées%) As Date
    Dim d As Date
        d = DateSerial(Year(MaDate) + NbAnnées, Month(MaDate), Day(MaDate))
        DateSortie4 = (Month(MaDate) <> Month(d)) + d
    End Function
    ou
    VB:
    Function DateSortie4bis(MaDate As Date, NbAnnées%) As Date
        DateSortie4bis = (Month(MaDate) <> Month(DateSerial(Year(MaDate) + NbAnnées, Month(MaDate), Day(MaDate)))) _
            + DateSerial(Year(MaDate) + NbAnnées, Month(MaDate), Day(MaDate))
    End Function


ROGER2327
#6921


Mardi 17 Haha 141 (Saint Homais d’Aquin, prudhomme - fête Suprême Quarte)
1[SUP]er[/SUP] Brumaire An CCXXII, 0,3944h - pomme
2013-W43-2T00:56:48Z
 

Magic_Doctor

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Bonjour Dranreb, ROGER2327,

Merci pour vos réponses. Je les ai compilées :
VB:
Function DateSortie(MaDate As Date, NbYears As Byte) As Date
'Renvoie la date correspondant à une date donnée + un nombre d'années donné.
'1/ la date de départ commence un 1er janvier, la date résultante sera le 31/12 de l'année [a + NbYears - 1]
'2/ la date est un 29 février d'une année bissextile, la date résultante sera :
'- si[a + NbYears] est une année bissextile : 29/2 de l'année [a + NbYears]
'- si[a + NbYears] n'est pas une année bissextile : 28/2 de l'année [a + NbYears]
'ROGER2327 / Dranreb / Magic_Doctor
    Dim j As Byte, m As Byte, a As Integer
    j = Day(MaDate): m = Month(MaDate): a = Year(MaDate)
    DateSortie = DateSerial(a + NbYears, m, j)
    If j + m = 2 Then
        DateSortie = DateSortie - 1
    Else
        DateSortie = DateSortie + (Not LeapYear(a + NbYears)) * (m = 2) * (j = 29)
    End If
End Function
VB:
Function LeapYear(a%) As Boolean
'Vérifie si une année est bissextile ou pas (tient compte des années théoriquement bissextiles et qui ne le sont en fait pas)
'ROGER2327
    LeapYear = ((a Mod 4) = 0) * (1 + ((a Mod 100) = 0) * (1 + (((a \ 100) Mod 4) = 0)))
End Function
 

ROGER2327

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Suite...


J'ai oublié de bricoler le premier janvier !

Correction :​
VB:
Function DateSortie(MaDate As Date, NbAnnées%) As Date
    DateSortie = DateSerial(Year(MaDate) + NbAnnées, Month(MaDate), Day(MaDate)) _
        + (Not LeapYear(Year(MaDate) + NbAnnées)) * (Month(MaDate) = 2) * (Day(MaDate) = 29) _
        + Year(MaDate - 1) - Year(MaDate)
End Function

Function LeapYear(a%) As Boolean
    LeapYear = ((a Mod 4) = 0) * (1 + ((a Mod 100) = 0) * (1 + (((a \ 100) Mod 4) = 0)))
End Function


Bonne journée,


ROGER2327
#6923


Mardi 17 Haha 141 (Saint Homais d’Aquin, prudhomme - fête Suprême Quarte)
1[SUP]er[/SUP] Brumaire An CCXXII, 4,3181h - pomme
2013-W43-2T10:21:48Z
 

Dranreb

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Bonjour
Soit, mais il me semblait qu'il suffisait de contrôler si le mois de DateSortie était bien toujours M. En effet la seule conséquence de spécifier à DateSerial un 29 février d'une année non bissextile est de lui en faire déduire un 1er mars !
 

ROGER2327

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Re...


Bonjour
Soit, mais il me semblait qu'il suffisait de contrôler si le mois de DateSortie était bien toujours M. En effet la seule conséquence de spécifier à DateSerial un 29 février d'une année non bissextile est de lui en faire déduire un 1er mars !

Oui !


VB:
Function DateSortie(MaDate As Date, NbAnnées%) As Date
Dim d As Date
    d = DateSerial(Year(MaDate) + NbAnnées, Month(MaDate), Day(MaDate))
    DateSortie = Year(MaDate - 1) - Year(MaDate) + (Month(MaDate) <> Month(d)) + d
End Function


ROGER2327
#6924


Mardi 17 Haha 141 (Saint Homais d’Aquin, prudhomme - fête Suprême Quarte)
1[SUP]er[/SUP] Brumaire An CCXXII, 4,4275h - pomme
2013-W43-2T10:37:34Z
 

Modeste geedee

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Bonsour®
Bonsoir Modeste geedee,

Dans mon exemple, ainsi que dans la fonction, je précise bien qu'au 29 février correspondra, si l'année n'est pas bissextile, le 28 février. Après tout cela me semble logique, on ne quitte pas le mois de février.

VB:
Function datesortie(target As Date, NbAn As Integer) As Date
datesortie = DateSerial(Year(target) + NbAn, Month(target), Day(target))
datesortie = datesortie + (Month(datesortie) <> Month(target))
End Function
 

Pièces jointes

  • Capture.JPG
    Capture.JPG
    60.4 KB · Affichages: 76
  • Capture.JPG
    Capture.JPG
    60.4 KB · Affichages: 97
  • Capture.JPG
    Capture.JPG
    60.4 KB · Affichages: 100

ROGER2327

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Re... Bonjour Modeste geedee.


Bonsour®


VB:
Function datesortie(target As Date, NbAn As Integer) As Date
datesortie = DateSerial(Year(target) + NbAn, Month(target), Day(target))
datesortie = datesortie + (Month(datesortie) <> Month(target))
End Function
C'est exactement la fonction DateSortie4 du message #5...​


ROGER2327
#6925


Mardi 17 Haha 141 (Saint Homais d’Aquin, prudhomme - fête Suprême Quarte)
1[SUP]er[/SUP] Brumaire An CCXXII, 5,3691h - pomme
2013-W43-2T12:53:09Z
 

Magic_Doctor

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Bonjour,

Je reviens sur ce fil car, entre temps, les choses se sont légèrement compliquées.
La fonction que m'a proposé ROGER2327 :
VB:
Function DateSortie(MaDate As Date, NbAnnées%) As Date
    DateSortie = DateSerial(Year(MaDate) + NbAnnées, Month(MaDate), Day(MaDate)) _
        + (Not LeapYear(Year(MaDate) + NbAnnées)) * (Month(MaDate) = 2) * (Day(MaDate) = 29) _
        + Year(MaDate - 1) - Year(MaDate)
End Function
--------------------------------------------------------------------------
Function LeapYear(a%) As Boolean
    LeapYear = ((a Mod 4) = 0) * (1 + ((a Mod 100) = 0) * (1 + (((a \ 100) Mod 4) = 0)))
End Function
résolvait bien le problème initial, à savoir :
je choisis une date à laquelle je rajoute un nombre d'années et je veux connaître la date résultante (en tenant en compte du problème des années bissextiles : "=DateSortie(29/02/2000;4)" --> 29/02/2004 | "=DateSortie(29/02/2000;5)" --> 28/02/2005), mais il y avait une condition : si la date est un 1er janvier, alors le résultat sera un 31 décembre : "=DateSortie(01/01/2000;4)" --> 31/12/2003.
Dans la fonction, je voudrais rajouter un paramètre, un mois :
Function DateSortie(MaDate As Date, NbAnnées%, m As Byte) As Date
m appartient à [1,12] (m est en fait un mois de clôture)
La condition précédente dépendra alors du mois. Exemples :
- "=DateSortie(01/01/2000;4;12)" --> 31/12/2003 (cas à l'origine)
- "=DateSortie(01/02/2000;4;1)" --> 31/01/2003
- "=DateSortie(01/03/2000;4;2)" --> 28/02/2003 | "=DateSortie(01/03/2000;5;2)" --> 29/02/2004
- "=DateSortie(01/04/2000;4;3)" --> 31/03/2003
- "=DateSortie(01/05/2000;4;4)" --> 30/04/2003
- "=DateSortie(01/06/2000;4;5)" --> 31/05/2003
.
.
- "=DateSortie(01/11/2000;4;10)" --> 31/10/2003
- "=DateSortie(01/12/2000;4;11)" --> 30/11/2003

En somme, si le jour de "MaDate" est un 1er et que son mois soit "m + 1", alors le résultat sera :
dernier jour du mois ("m") / mois ("m") / année ("MaDate") + nombre d'années rajoutées - 1

Merci pour tout conseil.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Bonjour.
Malgré l'edit, ce n'est toujours pas clair votre histoire.
Je vous propose ça :
VB:
Function DateSortie(ByVal MaDate As Date, ByVal DuréeEnMois As Long) As Date
Dim Jour As Integer, Mois As Integer, An As Integer
Jour = Day(MaDate): Mois = Month(MaDate): An = Year(MaDate)
DateSortie = DateSerial(An, Mois + DuréeEnMois, Jour - 1)
If Jour = 1 Then DuréeEnMois = DuréeEnMois - 1
Do While 12 * (Year(DateSortie) - An) + Month(DateSortie) - Mois > DuréeEnMois
   DateSortie = DateSortie - 1: Loop
End Function
 

ROGER2327

XLDnaute Barbatruc
Re : une fonction qui renvoie parfois une date erronée

Bonjour à tous.


Une autre :​
VB:
Function DateSortie(MaDate As Date, NbAnnées%, DecMois%) As Date
    DateSortie = DateSerial(Year(MaDate) + NbAnnées, Month(MaDate), Day(MaDate)) _
        + (Not LeapYear(Year(MaDate) + NbAnnées)) * (Month(MaDate) = 2) * (Day(MaDate) = 29) _
        + Year(DateSerial(Year(MaDate), Month(MaDate) - DecMois, Day(MaDate)) - 1) _
        - Year(DateSerial(Year(MaDate), Month(MaDate) - DecMois, Day(MaDate)))
End Function

Function LeapYear(a%) As Boolean
    LeapYear = ((a Mod 4) = 0) * (1 + ((a Mod 100) = 0) * (1 + (((a \ 100) Mod 4) = 0)))
End Function


Bon dimanche.


ℝOGER2327
#6945


Dimanche 1[SUP]er[/SUP] As 141 (Nativité de Pantagruel - fête Suprême Tierce)
13 Brumaire An CCXXII, 6,0856h - topinambour
2013-W44-7T14:36:19Z
 

Statistiques des forums

Discussions
291 501
Messages
1 915 830
Membres
178 990
dernier inscrit
shadowtheone
Haut Bas