age calcul entre 2 dates

[phil ed]

Bonsoir,

je cherche une formule pour calculer l'âge d'une personne
à une date déterminée

le fichier en annexe :
avec la formule ((-A2+B2)+1)/365
j'obtiens une réponse exacte sauf lorsque l'on se trouve quelques jours
avant la date anniversaire : dans le 2 ème cas de figure ,j'obtiens un
résultat de 28 ans alors que la personne n'a pas encore 28 ans
(je devrais obtenir 27,9)

influence des années bisextiles ?

quelqu'un peût il me procurer une formule exacte dans tous les cas de figure ?

merci

 

[Guiral]

Re : age calcul entre 2 dates

Bonjour,

J'avais les mêmes besoins que PhilEd et la fonction de VbaCrumble m'a bien aidée.

Sauf qu'il y a un petit défaut.
Pour que les calculs soit justes, il faut impérativement vérifier ce cas particulier :
Si le mois de fin est février, l'écart entre le dernier jour du mois de début et le dernier jour du mois de fin doit rester inférieur à 2.

Ceci parce que le programme ne trouvant pas le jour anniversaire du mois en février (pas de 30 ni de 31), il ne sait pas remettre le compteur de jours à 0 avant le mois suivant.

Ce problème ne se pose pas lorsque l'écart est de 1, puisque le changement de mois coïncide avec le premier jour du mois suivant.

Exemple :


Debut..... Fin....... Résultat. Observation
---------- ---------- --------- ---------------------------------------------
31/01/2010 28/02/2010 0a 0m 28j Ok
31/01/2010 01/03/2010 0a 1m -2j -2 jours, écart de 3 jours
31/01/2010 02/03/2010 0a 1m -1j -1 jour, écart de 3 jours
31/01/2010 03/03/2010 0a 1m 0j écart de 3 jours
31/01/2010 04/03/2010 0a 1m 1j décalage de 3 jours, persistant sur tout le mois


Des valeurs négatives dans une série positive, ça fait un peu désordre...

Pour corriger le truc, il faut dont artificiellement forcer le traitement comme si février était un mois de 30 jours.

On peut faire comme ceci :


If (Retenue = 28) And (Day(Debut) = 31) Then
Retenue = Retenue + 2
ElseIf (Retenue = 28) And (Day(Debut) = 30) Then
Retenue = Retenue + 1
ElseIf (Retenue = 29) And (Day(Debut) = 31) Then
Retenue = Retenue + 1
End If


On devrait pouvoir faire plus synthétique, mais au moins le code est explicite.

Avec pour résultat :


Debut..... Fin....... Résultat. Observation
---------- ---------- --------- ---------------------------------------------
31/01/2010 28/02/2010 0a 0m 28j Ok
31/01/2010 01/03/2010 0a 1m 0j Ok
31/01/2010 02/03/2010 0a 1m 1j Ok
31/01/2010 03/03/2010 0a 1m 2j Ok
31/01/2010 04/03/2010 0a 1m 3j Ok


Le code complet serait donc :


Function ECARTDATE(Debut, Fin) As String

Dim Nba As Integer, Nbm As Integer, Nbj, Retenue As Integer

Nba = Year(Fin) - Year(Debut)
Nbm = Month(Fin) - Month(Debut)
Nbj = Day(Fin) - Day(Debut)

Retenue = Day(DateSerial(Year(Fin), Month(Fin), 0))

If (Retenue = 28) And (Day(Debut) = 31) Then
Retenue = Retenue + 2
ElseIf (Retenue = 28) And (Day(Debut) = 30) Then
Retenue = Retenue + 1
ElseIf (Retenue = 29) And (Day(Debut) = 31) Then
Retenue = Retenue + 1
End If

If Nbj < 0 Then
Nbm = Nbm - 1
Nbj = Nbj + Retenue
End If
If Nbm < 0 Then
Nba = Nba - 1
Nbm = Nbm + 12
End If
If Debut > Fin Then
ECARTDATE = "#CHRONOLOGIE!"
Else
ECARTDATE = Nba & "a " & Nbm & "m " & Nbj & "j"
End If

End Function


Amicalement,

 

[acheghib]

bonjour,
j'aimerai que la tranche d'age s'affiche automatiquement selon le contenu d'une cellule,
je travail sur excel 2007.
veuillez trouver ci joint une copie de fichier attaché.
merci d'avance.

 

[Hasco]

Bonjour @acheghib,

Il est préférable de créer votre propre discussion en cliquant sur le bouton orangé 'Créer une discussion', en haut à droite de la page Forum excel

D'autant plus que vous avez quatté un autre fil de discussion. Chaque situation à ses particularités qui méritent leur propre discussion.

bonne soirée

 

[patricktoulon]

bonjour
si ça intéresse toujours quelqu'un
la formule manipulée par vba dans evaluate dans une fonction
la fonction accepte 1 ou 2 argument
si le 2d argument(date) est omis c'est la date d'aujourd'hui qui est prise

Function age(dat1, Optional dat2)
    If IsMissing(dat2) Then dat2 = Date
    age = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""y"")& "" ans "" & DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""ym"") & "" mois "" & DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""md"")") & " jours"
End Function

test en vba

Sub test()
MsgBox age(CDate("04/03/1970"))
End Sub
'
Sub test2()
MsgBox age(CDate([A1]))
End Sub
'

formule de base
=age(A1)
ou
=age(A1;B1)