Calcul age dans Excel avec des date avant 1900

Bonsoir,

J'ai de gros soucis avec la programmation VBA. En effet, je viens juste de commencer de m’intéresser au sujet car je dois produire un fichier calculant des ages avec une date inférieure à 1900.

Etant débutant, j'ai du mal à comprendre les codes employés et à jongler avec.

Je vous fais parvenir un fichier qui je l'espère vous permettra de comprendre et résoudre mon problème.

Merci par avance pour votre réponse.

Bonsoir Horus,

Voici un début de piste '=ANNEE(AUJOURDHUI())-ENT(DROITE(C4;4))', en effet datediff n'est pas compatible avec les dates antérieurs à 1900, pour pallier le problème je retranscris la date au format texte afin d'extraire l'année et la soustraire.

Fl@

Bonsoir,

Peut-être ce code VBA trouvé sur un site

Cordialement

Bonsoir,

Les réponses peuvent résoudre en partie mon problème mais je n'obtiens pas le résultat souhaite dans la cellule D7. Je m'explique, je souhaite le nombre d'années, de mois et de jours et non uniquement années de vie.

Quand à la cellule C9, le calcule doit être possible aussi si les cellules C4 et C7 ont des dates inférieures à 1900.

Merci pour vos propositions.

Bonsoir Horus-Sekmeb

Forcément si le jour/mois de décès est le même que le jour/mois de naissance,
vous ne pouvez obtenir qu'un nombre d'année

Je me suis amusé à modifier la date de décès et voilà

Le code de Patrick Toulon fonctionne parfaitement

Function DATEDIFF_AMJ5$(ByVal dat1 As Date, Optional ByVal dat2 As Date = 0, Optional JustYear As Boolean = False)
'**************************************
'auteur:patricktoulon
'*************************************
    Dim A$, M$, J$, Dtemp$, et$, yeardécalée&, y
    If dat2 = 0 Then dat2 = Date
    If dat1 > dat2 Then Dtemp = dat2: dat2 = dat1: dat1 = Dtemp

    If dat1 <= CDate("10/12/1562") Then dat1 = dat1 + IIf(Month(dat1) > 11, 10, 1)
    If dat2 <= CDate("10/12/1562") Then dat2 = dat2 + IIf(Month(dat1) > 11, 10, 1)

    'If dat1 <= CDate("10/12/1562") Then dat1 = dat1 + 10
    'If dat2 <= CDate("10/12/1562") Then dat2 = dat2 + 10

    dat1 = DateSerial(Year(dat1) + 2000, Month(dat1), Day(dat1))
    dat2 = DateSerial(Year(dat2) + 2000, Month(dat2), Day(dat2))

    A = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""y"")")
    M = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""ym"")")
    J = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""md"")")
    A = IIf(A = 0, "", IIf(A = 1, A & " an", A & " ans"))
    M = IIf(M = 0, "", IIf(M >= 1, M & " mois", M & " mois"))
    J = IIf(J = 0, "", IIf(J = 1, "1  jour", J & " jours"))
    et = IIf(Val(A) > 0 Or Val(M) > 0, IIf(Val(J) > 0, " et ", " "), "")
    DATEDIFF_AMJ5 = Application.Trim(A & IIf(Not JustYear, " " & M & " " & et & J, ""))
End Function

Bonne nuit

Bonsoir tout le monde,

@Bruno, tu m'as devancé mais j'ai opté pour une solution en formule et non en VBA , voici une formule à appliquer en 'D4'

=SI(SI(ABS(ANNEE(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(DROITE(C4;4));ANNEE(C4)))>1; ABS(ANNEE(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(DROITE(C4;4));ANNEE(C4))) & " ans"; "")<>"";SI(ABS(ANNEE(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(DROITE(C4;4));ANNEE(C4)))>1; ABS(ANNEE(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(DROITE(C4;4));ANNEE(C4))) & " ans"; "");SI(SI(ABS(JOUR(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(GAUCHE(C4;2));JOUR(C4)))>1;ABS(JOUR(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(GAUCHE(C4;2));JOUR(C4)))&" jours";SI(ABS(JOUR(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(GAUCHE(C4;2));JOUR(C4)))=1;"1 jour";""))<>"";SI(ABS(MOIS(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(STXT(C4;4;2));MOIS(C4)))>=1;MOIS(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(STXT(C4;4;2));MOIS(C4))&" mois";"") & " " & SI(ABS(JOUR(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(GAUCHE(C4;2));JOUR(C4)))>1;ABS(JOUR(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(GAUCHE(C4;2));JOUR(C4)))&" jours";SI(ABS(JOUR(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(GAUCHE(C4;2));JOUR(C4)))=1;"1 jour";""));SI(SI(ABS(MOIS(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(STXT(C4;4;2));MOIS(C4)))>=1;MOIS(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(STXT(C4;4;2));MOIS(C4))&" mois";"")<>"";SI(ABS(MOIS(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(STXT(C4;4;2));MOIS(C4)))>=1;MOIS(AUJOURDHUI())-SI(ESTNUM(C4)=FAUX;ENT(STXT(C4;4;2));MOIS(C4))&" mois";"");"")))

Bonjour,
Aïe ! Attention au bug md avec Datedif.
Exemple :
Naissance 31/7/1850
Décès 1/3/1910
Le résultat donné par la fonction est 59 ans 7 mois et - 2 jours
Le nombre de jours est négatif (moins 2 jours).
Cdlt.

@Jean Eric, oui c'est pour cela que j'ai préféré travailler en entier et comparer plutôt qu'avec les dates.

Bonjour,
La formule J résout le problème des jours.
Cdlt.

A : Datedif(début; fin;"y")
M : Datedif(début; fin; "ym")
J : fin - Mois.Decaler(début; A * 12 + M)

bonjour Jean-Eric, Florian53,BrunoM45,Horus_Sekmeb,boss_68,

même système dans l'USF

Function DATEDIFF_AMJ5$(ByVal dat1 As Date, Optional ByVal dat2 As Date = 0, Optional JustYear As Boolean = False)
     '**************************************
     'auteur:patricktoulon
     'debug for negative numbers of days solved
     '*************************************
     Dim A$, M$, J$, Dtemp$, et$, yeardécalée&, y
     If dat2 = 0 Then dat2 = Date
     If dat1 > dat2 Then Dtemp = dat2: dat2 = dat1: dat1 = Dtemp

     If dat1 <= CDate("10/12/1562") Then dat1 = dat1 + IIf(Month(dat1) > 11, 10, 1)
     If dat2 <= CDate("10/12/1562") Then dat2 = dat2 + IIf(Month(dat1) > 11, 10, 1)

     'If dat1 <= CDate("10/12/1562") Then dat1 = dat1 + 10
     'If dat2 <= CDate("10/12/1562") Then dat2 = dat2 + 10

     dat1 = DateSerial(Year(dat1) + 2000, Month(dat1), Day(dat1))
     dat2 = DateSerial(Year(dat2) + 2000, Month(dat2), Day(dat2))

     A = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""y"")")
     M = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""ym"")")
     J = CLng(dat2 - WorksheetFunction.EDate(dat1, 12 * A + M))
     A = IIf(A = 0, "", IIf(A = 1, A & " an", A & " ans"))
     M = IIf(M = 0, "", IIf(M >= 1, M & " mois", M & " mois"))
     J = IIf(J = 0, "", IIf(J = 1, "1  jour", J & " jours"))
     et = IIf(Val(A) > 0 Or Val(M) > 0, IIf(Val(J) > 0, " et ", " "), "")

     DATEDIFF_AMJ5 = Application.Trim(A & IIf(Not JustYear, " " & M & " " & et & J, ""))
End Function

Re,
@Bart, l'adepte de la traite (des vaches),
Un petit message à l'attention de Patrick Toulon (patricktoulon sur le forum) pour l'avertir de la modification de sa procédure ?
Cdlt.

Bonjour,

Je remercie tous le monde pour vos réponses et suggestions.

La solution VBA fonctionne correctement. Hier soir, un peu fatigué donc pas manipulé mon fichier correctement afin que la solution de Pactrick Toulon fonctionne parfaitement.

Je viens depuis quelques minutes de m'y remettre et tout est ok.

Encore merci à vous tous pour votre rapidité de réponse et votre aide.

Bonne journée à tous.

Re,
Merci de ce retour.
Cdlt.

re, @Jean-eric,

Un petit message à l'attention de Patrick Toulon (patricktoulon sur le forum) pour l'avertir de la modification de sa procédure ?

Je ne sais pas comment, donc si vous pouvez le faire ...

Re,
@Bart,
C'est fait !
Bonne journée.

Bonsoir à tous
ok l'erreur est vu
merci à tous

pour info j'etais curieux alors

j'ai retesté sur 2007 j'ai bien 59 ans 7 mois et 1 jour
j'ai testé sur 2013 et j'ai pas -2 mais -1 jour

je vous laisse juger de la fiabilité de la fonction excel datediff sur les versions recentes de excel

j'avais utilisé à l'époque evaluate et datediff car celle de vba c'est pire mais ça on le sait depuis longtemps

après descendre en dessous de 1800 est absurde car certaines nations ont adopté le calendrier grégorien en 1761 d'autre 15xx etc....

exemple

Patrick

re

Function DATEDIFF_AMJ4$(ByVal dat1 As Date, Optional ByVal dat2 As Date = 0, Optional JustYear As Boolean = False)
'**************************************
'auteur:patricktoulon
'*************************************
    Dim A$, M$, J$, Dtemp$, et$, yeardécalée&, y
    If dat2 = 0 Then dat2 = Date
    If dat1 > dat2 Then Dtemp = dat2: dat2 = dat1: dat1 = Dtemp

    If Year(dat1) < 1904 Then If Year(dat1) Mod 4 <> 0 Or Year(dat1) Mod 400 <> 0 Then y = 2020 Else y = 1905
    If Year(dat1) < y Then
        'on decale la date la plus ancienne (Dat1)à l'année 1904
        yeardécalée = Abs((Year(dat1) - y))
        dat1 = DateSerial(Year(dat1) + yeardécalée, Month(dat1), Day(dat1))
        dat2 = DateSerial(Year(dat2) + yeardécalée, Month(dat2), Day(dat2))
    End If

    A = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""y"")")
    M = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""ym"")")
    J = Abs(Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""md"")"))

    A = IIf(A = 0, "", IIf(A = 1, A & " an", A & " ans"))
    M = IIf(M = 0, "", IIf(M >= 1, M & " mois", M & " mois"))
    J = IIf(J = 0, "", IIf(J = 1, "1  jour", J & " jours"))
    et = IIf(Val(A) > 0 Or Val(M) > 0, IIf(Val(J) > 0, " et ", " "), "")

    DATEDIFF_AMJ5 = Application.Trim(A & IIf(Not JustYear, " " & M & " " & et & J, ""))
End Function

Bonjour,
Merci de ce retour,
Attendons l"analyse de Bart.
Mais il est peut-être sur les routes de France, à rejoindre Paris, pour sauver nos agriculteurs.
Cdlt..

re,

@Jean-Eric, je suis un fervent partisan de la grève des agriculteurs, à condition qu'elle ne détruise rien. Ces petites règles de Bruxelles sont parfois contre-productives et mortelles.

@PatrickT, c'est bien mais un tout petit modif comme option pour avoir les résultats dans une matrice au lieu d'un string

Bonjour BsAIV

oui apres tu peux la modifier tres facilement pour qu'elle te retourne une matrice (3 element) (an,mois,jour)

tu peux le faire en derniere ligne

perso la réponse prévue est textuelle

quel âge a tu ?

j'ai 53 ans 10 mois et 25 jours

Après si tu veux on peut imaginer une injection récupération avec 3 variable communes un peu comme le font certaines fonction api

la fonction peut être alors utilisée comme une sub ou fonction responsive

du genre

Function DATEDIFF_AMJ4(ByVal dat1 As Date, Optional ByVal dat2 As Date = 0, Optional JustYear As Boolean = False, Optional A& = 0, Optional M& = 0, Optional J& = 0)
'**************************************
'auteur:patricktoulon
'*************************************
    Dim Dtemp$, et$, yeardécalée&, y
    If dat2 = 0 Then dat2 = Date
    If dat1 > dat2 Then Dtemp = dat2: dat2 = dat1: dat1 = Dtemp

    If Year(dat1) < 1904 Then If Year(dat1) Mod 4 <> 0 Or Year(dat1) Mod 400 <> 0 Then y = 2020 Else y = 1905
    If Year(dat1) < y Then
        'on decale la date la plus ancienne (Dat1)à l'année 1904
        yeardécalée = Abs((Year(dat1) - y))
        dat1 = DateSerial(Year(dat1) + yeardécalée, Month(dat1), Day(dat1))
        dat2 = DateSerial(Year(dat2) + yeardécalée, Month(dat2), Day(dat2))
    End If

    A = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""y"")")
    M = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""ym"")")
    J = Abs(Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""md"")"))
    Dim AB$, Mb$, Jb$
    AB = IIf(A = 0, "", IIf(A = 1, A & " an", A & " ans"))
    Mb = IIf(M = 0, "", IIf(M >= 1, M & " mois", M & " mois"))
    Jb = IIf(J = 0, "", IIf(J = 1, "1  jour", J & " jours"))
    et = IIf(Val(A) > 0 Or Val(M) > 0, IIf(Val(J) > 0, " et ", " "), "")
    DATEDIFF_AMJ4 = Application.Trim(AB & IIf(Not JustYear, " " & Mb & " " & et & Jb, ""))

End Function

Sub test()
    Dim A&, M&, J&
   'mode sub
 DATEDIFF_AMJ4 DateSerial(1961, 9, 15), , , A, M, J
    MsgBox A & vbCrLf & M & vbCrLf & J

'mode fonction responsive 
    MsgBox DATEDIFF_AMJ4(DateSerial(1961, 9, 15))

End Sub

bref comme tu peux le voir on peut faire des tas de transformations

mais le moteur est fonctionnel et ne change pas

et surtout comme tu vois je n'ai pas fait de condition dans la fonction pour un type de retour ou un autre

ca se fait fluidemment car les deux returns type existent