une fonction qui renvoie parfois une date erronée

Magic_Doctor

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:
Trier par date Trier par votes
Modeste geedee

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))
 
Vote positif 0 Vote négatif
Magic_Doctor

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:
Vote positif 0 Vote négatif
Dranreb

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:
Vote positif 0 Vote négatif
ROGER2327

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
 
Vote positif 0 Vote négatif
Magic_Doctor

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
 
Vote positif 0 Vote négatif
ROGER2327

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
 
Vote positif 0 Vote négatif
Dranreb

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 !
 
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

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

Re...


Dranreb à dit:
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 !
Cliquez pour agrandir...

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
 
Vote positif 0 Vote négatif
Modeste geedee

Modeste geedee

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

Bonsour®
Magic_Doctor à dit:
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.
Cliquez pour agrandir...

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: 95
  • Capture.JPG
    Capture.JPG
    60.4 KB · Affichages: 116
  • Capture.JPG
    Capture.JPG
    60.4 KB · Affichages: 118
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

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

Re... Bonjour Modeste geedee.


Modeste geedee à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
Magic_Doctor

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:
Vote positif 0 Vote négatif
Dranreb

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
 
Vote positif 0 Vote négatif
ROGER2327

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
 
Vote positif 0 Vote négatif

Discussions similaires

E
  • Résolu(e)
Microsoft 365 Ajout et Suppression Date automatique
Réponses
9
Affichages
392
eric72
E
Magic_Doctor
  • Question
XL 2010 Une curiosité avec une fonction personnalisée qui renvoie une date
Réponses
4
Affichages
541
Magic_Doctor
Magic_Doctor
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
880
Nicolas JACQUIN
Nicolas JACQUIN
mromain
Génération de QR Codes
Réponses
1
Affichages
676
Cousinhub
Cousinhub
A
  • Question
XL 2016 Combobox Saisie Date
Réponses
12
Affichages
715
aurelio.ewane
A
VBA_dev_Anne_Marie
  • Résolu(e)
Microsoft 365 VBA : Calculer la date de fin de trimestre
2 3
Réponses
30
Affichages
3 K
eCHO
E
B
  • Question
Microsoft 365 colorer une plage
Réponses
2
Affichages
792
bd.afaf
B
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
1 K
un internaute
U
U
  • Question
Autres [RESOLU] Application.ScreenUpdating = False
Réponses
4
Affichages
1 K
un internaute
U
patricktoulon
  • Suggestion
Date et heure DATEDIFF_AMJ4
Réponses
10
Affichages
2 K
eriiic
eriiic

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 74 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA