Microsoft 365 vba pour avoir âge en année mois jours

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

libellule85

XLDnaute Accro
Bonjour le forum,
Etant nulle en VBA, et que le complément Age.xlam ne fonctionne plus...
Est-ce qu'un forumer pourrait me donner le code vba pour avoir la même chose que le résultat obtenu avec Age.xlam, s'il vous plait. (c'est à dire en mettant une date dans a1 et une en b1 par exemple et en utilisant la fonction age on obtenait la différence en année mois et jours).
J'ai essayé avec la formule en utilisant "datedif" mais celle-ci n'est pas fiable à 100% !

D'avance merci pour votre aide
 
Bonjour Libellule,
Une excellente fonction de PatrickToulon :
 

Pièces jointes

Bonjour le forum,
Etant nulle en VBA, et que le complément Age.xlam ne fonctionne plus...
Est-ce qu'un forumer pourrait me donner le code vba pour avoir la même chose que le résultat obtenu avec Age.xlam, s'il vous plait. (c'est à dire en mettant une date dans a1 et une en b1 par exemple et en utilisant la fonction age on obtenait la différence en année mois et jours).
J'ai essayé avec la formule en utilisant "datedif" mais celle-ci n'est pas fiable à 100% !

D'avance merci pour votre aide
Bonjour ce n'est pas qu'elle n'est pas fialble c'est que beaucoup interpretent le resultat qu'elle donnent comme une erreur sauf qu'en vérité ça n'en est pas
certes quand on cherche un résultat an/mois/jour il faut tricoter mais les fonction natives rendent exactement ce qu'elles sont sensés renvoyer
 
re:
@libellule85 , @sylvanu
du coup je l'ai mise a jour ,je lui ai ajouté des option s; le multi returnMode
VB:
Function DATEDIFF_AMJ4$(ByVal dat1 As Date, Optional ByVal dat2 As Date = 0, Optional ReturnMode As String = 0)
    '**************************************
    ' fonction DateDiffAMJ V°4
    ' auteur:patricktoulon sur Exceldownloads
    ' date de mise en jour V°4:04/07/2021
    ' mise a jour supplementaire
    ' ajout de l'argument boolean "JustYear" pour ne récuprérer que les années
    ' mise à jour 09/102025
    ' suppression de l'argument boolean "Justyear" et remplaement par un variant
    ' pouvant ùodifier le return
    ' an ou mois ou jour ou les trois  en textuelou les trois en array
    '*************************************
    Dim A$, M$, J$, Ax&, Mx&, Jx, 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"")"): Ax = A
    M = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""ym"")"): Mx = M
    J = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""md"")"): Jx = J
 
    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 ", " "), "")
       Select Case LCase(CStr(ReturnMode))
        Case "a", "1": DATEDIFF_AMJ4 = Ax
        Case "m", "2": DATEDIFF_AMJ4 = Mx
        Case "j", "3": DATEDIFF_AMJ4 = Jx
        Case "amj", "4", "0": DATEDIFF_AMJ4 = Application.Trim(A & M & " " & et & J)
        Case "T", 5: DATEDIFF_AMJ4 = Array(Ax, Mx, Jx)
    End Select
 End Function

les méthodes:
Code:
=datediffAMJ4(date1;date2)       différence textuelle
=datediffAMJ4(date1)                 anniversaire textuelle  par date2 par defaut
=datediffAMJ4(date1;date2;1)    année   argument (1 ou "a" ou "A")
=datediffAMJ4(date1;date2;2)    les mois   argument (2 ou "m" ou "M")
=datediffAMJ4(date1;date2,3)    les jours   argument (3 ou "j" ou "J")
=datediffAMJ4(date1;date2,4)    différence textuelle  argument (0 ou 4 ou "amj" ou "AMJ" )
=datediffAMJ4(date1;date2,5)    un array des trois datas de date argument (5 ou "t" ou "T") pratique pour le vba
 
Bpn ben puisque ca vous a plu j'en rajoute une couche
elle retourne la difference en nombre de mois (paratique pour la compta et les stat salarié
VB:
Function DATEDIFF_AMJ4$(ByVal dat1 As Date, Optional ByVal dat2 As Date = 0, Optional ReturnMode As String = 0)
    '**************************************
    ' fonction DateDiffAMJ V°4
    ' auteur:patricktoulon sur Exceldownloads
    ' date de mise en jour V°4:04/07/2021
    ' mise a jour supplementaire
    ' ajout de l'argument boolean "JustYear" pour ne récuprérer que les années
    ' mise à jour 09/102025
    ' suppression de l'argument boolean "Justyear" et remplaement par un variant
    ' pouvant ùodifier le return
    ' an ou mois ou jour ou les trois  en textuelou les trois en array ou en nombre de mois
    '*************************************
    Dim A$, M$, J$, Ax&, Mx&, Jx, 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"")"): Ax = A
    M = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""ym"")"): Mx = M
    J = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""md"")"): Jx = J
 
    A = IIf(A = 0, "", IIf(A = 1, A & " an ", A & " ans "))
    M = IIf(M = 0, "", 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 ", " "), "")
       Select Case LCase(CStr(ReturnMode))
        Case "a", "1": DATEDIFF_AMJ4 = Ax
        Case "m", "2": DATEDIFF_AMJ4 = Mx
        Case "mm", "6": DATEDIFF_AMJ4 = (Ax * 12) + Mx & " mois"
        Case "j", "3": DATEDIFF_AMJ4 = Jx
        Case "amj", "4", "0": DATEDIFF_AMJ4 = Application.Trim(A & M & " " & et & J)
        Case "T", 5: DATEDIFF_AMJ4 = Array(Ax, Mx, Jx)
    End Select
 End Function
1760092626996.png

un dessert avec ça ?
 
Bonjour @libellule85🙂, @patricktoulon😉,

Pour le fun, je ressors un très ancien truc que j'avais pondu (remis au goût du jour).
Quand on affiche un texte, on le fait sous la forme: 12a 0m 11j (les nombres de mois et de jours sont toujours sur deux caractères dont éventuellement le premier est un espace. C'est selon moi plus lisible et ça permet d'extraire facilement chaque nombre dans une cellule avec une formule simple. On peut aussi bien sûr suivant le 3ème paramètre extraire ce qu'on veut.
La fonction s'appelle Age(...)

Son code (qui ne fait pas appel aux fonctions de feuille de calcul) :
VB:
Function Age(ByVal dat1 As Date, ByVal dat2 As Date, Optional Quoi = 0)
' Calcule la différence en années, mois et jours entre les dates dat1 et dat2
' si Quoi est manquant ou vaut "0", 0  => on renvoie un texte: 5a 10m  7j
' si Quoi vaut "a", "y", "1", 1        => on renvoie un nombre: 5
' si Quoi vaut "m", "2", 2             => on renvoie un nombre: 10
' si Quoi vaut "j", "d", "3", 3        => on renvoie un nombre: 7
' si Quoi vaut "mat", "arr", "4", 4    => on renvoie un array égal à (5,10,7)
' sinon on renvoie la même valeur que si Quoi était manquant
Dim aux&, an1&, mois1&, jour1&, ans&, mois&, jours&, i&
   dat1 = Int(dat1): dat2 = Int(dat2)
   If dat1 > dat2 Then aux = dat1: dat1 = dat2: dat2 = aux
   an1 = Year(dat1): mois1 = Month(dat1): jour1 = Day(dat1)
   i = Year(dat2) - an1 - 1: Do While DateSerial(an1 + i, mois1, jour1) <= dat2: i = i + 1: Loop
   ans = i - 1
   i = 0: Do While DateSerial(an1 + ans, mois1 + i, jour1) <= dat2: i = i + 1: Loop
   mois = i - 1
   i = 0: Do While DateSerial(an1 + ans, mois1 + mois, jour1 + i) <= dat2: i = i + 1: Loop
   jours = i - 1
   Select Case LCase(Quoi)
      Case "0", 0: Age = ans & "a " & Format(mois, IIf(mois < 10, " 0", "00")) & "m " & Format(jours, IIf(jours < 10, " 0", "00")) & "j"
      Case "a", "y", "1", 1: Age = ans
      Case "m", "2", 2: Age = mois
      Case "j", "d", "3", 3: Age = jours
      Case "mat", "arr", "4", 4: Age = Array(ans, mois, jours)
      Case Else:: Age = ans & "a " & Format(mois, IIf(mois < 10, " 0", "00")) & "m " & Format(jours, IIf(jours < 10, " 0", "00")) & "j"
   End Select
End Function
...
 

Pièces jointes

Bonjour,
En 2019, je crois, il a été mis en évidence un bug avec DateDif et le paramètre "md".
Dont le principal qui pouvait retourner un nombre de jours négatif.
Pour éviter ce bug, il a été préconisé d'utiliser :
y = DateDif (début; fin; "y")
m = DateDif(début; fin; "ym")
d; fin - Mois.decaler( début; y * 12 + m)
La fonction VBA de Patrick, ou la formule de Raccourcix (merci pour la simplication) sont directement concernées par ce bug (nombre négatif ou N/A). Quant à la fonction VBA de mapomme, il a souci aussi !...
Cordialement.

lien : TimeAndDate
 

Pièces jointes

Bonjour,

Si jamais :
Sans VBA, j'avais fait ça pour passer le temps:

(inscrire une date en A2)

Formule d'années en B2 :
Code:
=SI(A2<>"";ENT((F$2-A2)/365,25);"")

Formule pour les mois (en C2) :
Code:
=SI(B2>0;SI(A2<>"";ENT(MOD((F$2-A2)/365,25;B2)*12);"");ENT((F$2-A2)/365,25*12))

Pour les jours (formule en D2):
Code:
=SI(JOUR(F$2)=JOUR(A2);0;SI(JOUR(F$2)>JOUR(A2);SI(A2<>"";SI(JOUR(F$2)-JOUR(A2)>=0;JOUR(TEXTE(DATE(ANNEE(F$2);MOIS(F$2);JOUR(JOUR(F$2)-JOUR(A2)));"jj/mm/aaaa"));CNUM(F$2-DATE(ANNEE(F$2);MOIS(F$2)-1;JOUR(A2))));"");SI(A2<>"";SI(JOUR(F$2)-JOUR(A2)>=0;JOUR(TEXTE(DATE(ANNEE(F$2);MOIS(F$2);JOUR(JOUR(F$2)-JOUR(A2)));"jj/mm/aaaa"));CNUM(F$2-DATE(ANNEE(F$2);MOIS(F$2)-1;JOUR(A2))));"")+1))

En F2, j'avais mis :
Code:
=Aujourdhui()

dates1.jpg



Après, il existe la possibilité d'une MFC si mois ET jour d'une ligne = 0
ou toute autre choses (ex : =si(et(D2 = 0; C2 = 0) ; "Jour de fête !!!";"")
Bref, sans VBA c'est possible de calculer un annif ou un départ à la retraite.


PS : Cliquer sur j'aime ne coûte rien et ceux qui ont peur du VBA pourraient apprécier ce genre de réponses, non? J'avoue que parfois, sur les forums ont met presque la cuillère dans la bouche.
 
Dernière édition:
bonjour
ben des formules se relayant c'est pas top non plus
si il faut 4 colonnes pour avoir l'age en textuel............

surtout qu'avec les versions d'excel d’aujourd’hui on a lamda et voir mê sans ,on a la fonction let pour variabiliser les 3 dats
du coup j’espère que la cuillère n'est pas tro chaude ou trop froide

je peux éventuellement te prêter une louche si il faut ,si tu peux encore avaler quelque chose bien evidement


d'accords .... je sorts
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Résolu(e)
Microsoft 365 DateDif()
Réponses
5
Affichages
213
  • Résolu(e)
Microsoft 365 DATEDIF
Réponses
11
Affichages
224
Réponses
6
Affichages
406
Réponses
8
Affichages
444
Retour