Age en années, mois et jours

[alain18]

Bonjour le forum,
Je viens de mettre en place une formule afin de connaître l'age précis d'une personne et je me trouve avec un résultat étonnant:
Ma formule avec la date de naissance en G7: 28/05/1982
=DATEDIF(G7;AUJOURDHUI();"y")&" Ans "&DATEDIF(G7;AUJOURDHUI();"ym")&" mois "&DATEDIF(G7;AUJOURDHUI();"md")&" Jours "

Le résultat me donne: 29 Ans 7 Mois 121 Jours ; pourquoi 121 jours (nous sommes le 5 Janvier)

Merci d'éclairer ma lanterne...
Amicalement

 

[DoubleZero]

Re : Age en années, mois et jours

Re-bonjour,

La macro de ROGER2327 est insérée dans le fichier joint.

Quelques petites explications sont fournies.

Bon courage et à bientôt 🙂

P. S. : activer les macros...

 

[alain18]

Re : Age en années, mois et jours

Bonjour DoubleZero,
Je te remercie de ce petit fichier qui met enfin tout le monde d'accord avec la fonction de ROGER2327. Ceci dit, peut être à une journée près. Tout dépant si l'on compte la 1ère journée ou non. J'ai vu que ROGER en parlais dans son message. Rien de bien méchant puisque la modification peut être faite facilement.
Merci à tous.

Que Microsoft se tienne à carreau !! 2003 ou 2007 ?

 

[DoubleZero]

Re : Age en années, mois et jours

Bonjour, le Fil, le Forum,

... Tout dépant si l'on compte la 1ère journée ou non. J'ai vu que ROGER en parlais dans son message. Rien de bien méchant puisque la modification peut être faite facilement...

@ alain18 :

ROGER2327 a tout prévu ! Par conséquent, tu peux modifier, comme il le mentionne, cette ligne de code :

   j = j + 1 ' ou 0 selon les goûts...

Merci à ROGER2327 😱 et bonne continuation à toi 🙂.

 

[ROGER2327]

Re : Age en années, mois et jours

Bonjour à tous

J'ai repris mon code pour apporter quelques modifications.

• Une fonction simple :

  Function age(d As Date) As String
  Dim aa As Date, a&, m&, s&, j&
      aa = Now()
      If (d > 60) * (d <= aa) Then
          Do While DateSerial(Year(d) + a + 1, Month(d), Day(d)) < aa: a = a + 1: Loop
          Do While DateSerial(Year(d) + a, Month(d) + m + 1, Day(d)) < aa: m = m + 1: Loop
          Do While DateSerial(Year(d) + a, Month(d) + m, Day(d) + (s + 1) * 7) < aa: s = s + 1: Loop
          Do While DateSerial(Year(d) + a, Month(d) + m, Day(d) + s * 7 + j + 1) < aa: j = j + 1: Loop
          age = IIf(a, a & " an" & IIf(a > 1, "s", "") & " ", "") & IIf(m, m & " mois ", "") & IIf(s, s & " semaine" & IIf(s > 1, "s", "") & " ", "") & IIf(j Or (a + m + j = 0), j & " jour" & IIf(j > 1, "s", ""), "")
      End If
  End Function

  Syntaxe :
  =age(date)
  où date est une date postérieure au 28 février 1900 renvoie la différence date_courante - date1 en années, mois, semaines et jours.
  • =age("18/9/1988") renvoie 23 ans 3 mois 2 semaines 5 jours.
  
  
• Une fonction plus générale pour le calcul de la différence entre deux dates :

  Function diffDate(d1 As Date, d2 As Date) As String
  Dim d As Date, a&, m&, s&, j&
      d = WorksheetFunction.Min(d1, d2)
      If (d > 60) Then
          If (d <> d1) * (d1 <> d2) Then diffDate = "moins "                                                  'signe      '
          d2 = WorksheetFunction.Max(d1, d2): d1 = d
          Do While DateSerial(Year(d1) + a + 1, Month(d1), Day(d1)) <= d2: a = a + 1: Loop                    'Années     '
          Do While DateSerial(Year(d1) + a, Month(d1) + m + 1, Day(d1)) <= d2: m = m + 1: Loop                'Mois       '
          Do While DateSerial(Year(d1) + a, Month(d1) + m, Day(d1) + (s + 1) * 7) <= d2: s = s + 1: Loop      'Semaines   '
          Do While DateSerial(Year(d1) + a, Month(d1) + m, Day(d1) + s * 7 + j + 1) <= d2: j = j + 1: Loop    'Jours      '
          diffDate = diffDate & IIf(a, a & " an" & IIf(a > 1, "s", "") & " ", "") _
              & IIf(m, m & " mois ", "") _
              & IIf(s, s & " semaine" & IIf(s > 1, "s", "") & " ", "") _
              & IIf(j Or (a + m + j = 0), j & " jour" & IIf(j > 1, "s", ""), "")                              'Affichage  '
      End If
  End Function

  Syntaxe :
  =diffDate(date1;date2)
  où date1 et date2 sont des dates postérieures au 28 février 1900 renvoie la différence date2 - date1 en années, mois, semaines et jours.
  • =diffDate("18/9/1988";"26/10/2011") renvoie 23 ans 1 mois 1 semaine 1 jour ;
  • =diffDate("26/10/2011";"18/9/1988") renvoie moins 23 ans 1 mois 1 semaine 1 jour.
  
  
• Une fonction paramétrable :

  Function diffDateP(d1 As Date, d2 As Date, Optional An As Boolean = True, Optional Mo As Boolean = True, Optional Se As Boolean = True, Optional P As Boolean) As String
  Dim d As Date, a&, m&, s&, j&
      d = WorksheetFunction.Min(d1, d2)
      If (d > 60) Then
          If (d <> d1) * (d1 <> d2) Then diffDateP = "moins "                                                            'signe      '
          d2 = WorksheetFunction.Max(d1, d2): d1 = d - P * ((diffDateP = "") Or (d = d2))
          If An Then Do While DateSerial(Year(d1) + a + 1, Month(d1), Day(d1)) <= d2: a = a + 1: Loop                    'Années     '
          If Mo Then Do While DateSerial(Year(d1) + a, Month(d1) + m + 1, Day(d1)) <= d2: m = m + 1: Loop                'Mois       '
          If Se Then Do While DateSerial(Year(d1) + a, Month(d1) + m, Day(d1) + (s + 1) * 7) <= d2: s = s + 1: Loop      'Semaines   '
          Do While DateSerial(Year(d1) + a, Month(d1) + m, Day(d1) + s * 7 + j + 1) <= d2: j = j + 1: Loop               'Jours      '
          diffDateP = diffDateP & IIf(a, a & " an" & IIf(a > 1, "s", "") & " ", "") _
              & IIf(m, m & " mois ", "") _
              & IIf(s, s & " semaine" & IIf(s > 1, "s", "") & " ", "") _
              & IIf(j Or (a + m + j = 0), j & " jour" & IIf(j > 1, "s", ""), "")                                         'Affichage  '
      End If
  End Function

  Syntaxe :
  =diffDateP(date1;date2[;An;Mo;Se;P])
  où date1 et date2 sont des dates postérieures au 28 février 1900 et An, Mo, Se, P des paramètres optionnels_:
  • Si les paramètres optionnels An, Mo, Se sont omis (ou égaux à 1 ou VRAI), et le paramètre P est omis (ou égal à 0 ou FAUX) la fonction est semblable à la précédente ;
  • Si le seul paramètre An est 0 (ou FAUX), la différence est renvoyée en mois, semaines et jours_;
  • Si le seul paramètre Mo est 0 (ou FAUX), la différence est renvoyée en années, semaines et jours_;
  • Si le seul paramètre Se est 0 (ou FAUX), la différence est renvoyée en années, mois et jours_;
  • Le paramètre P défini à 1 (ou VRAI) permet d'obtenir des résultats stupides (en hommage à Bill, qui adore ça...).
  • =diffDateP("18/9/1988";"26/10/2011";;0;0) renvoie 23 ans 38 jours ;
  • =diffDateP("18/9/1988";"26/10/2011";0) renvoie 277 mois 1 semaine 1 jour ;
  • =diffDateP(AUJOURDHUI();AUJOURDHUI();;;;1) renvoie 1 jour contre toute logique.

ROGER2327
#5360

Lundi 9 Décervelage 139 (Dormition de Jacques Vaché, Interprète - fête Suprême Quarte)
16 Nivôse An CCXX, 7,2633h - silex
2012-W01-5T17:25:55Z

 

[alain18]

Re : Age en années, mois et jours

Bonjour et merci ROGER2327 pour ces supers codes qui permettent de contourner certain pb avec Excel 2007.
Cordialement.