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

Créer une discussion
Répondre

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 !

S'inscrire
libellule85

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
 
Trier par date Trier par votes
Bonjour Libellule,
Une excellente fonction de PatrickToulon :
patricktoulon

Date et heure Discussion 'DATEDIFF_AMJ4'

Bonjour a tous
j'avais fait une fonction "DATEDIFFAMJ" il y a quelque temps pour obtenir la différence entres deux date ans mois et jour
et un demandeur a faite une demande concernant la différence entre deux dates
sauf que lui avait besoins de faire la différence de dates 1 et 2 (entre deux siècles)
et pour couronner le tout avec des dates en dessous l'année 1900
j'ai donc repris ma fonction de base et utilisé une astuce simple
si pour la date la plus ancienne c'est une année divisible par 4 ou 400 je la décale en 2020( fevrier 28/29) sinon je la décale en...
  • J'aime
  • Wow
 

Pièces jointes

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

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

P
  • Résolu(e)
Microsoft 365 DateDif()
Réponses
5
Affichages
201
TooFatBoy
TooFatBoy
BenHarber
  • Question Question
Microsoft 365 VBA : fonction qui calcule une durée entre 2 dates en années, mois et jours
Réponses
8
Affichages
255
BenHarber
BenHarber
S
  • Question Question
XL 2021 Formule Excel ou code VBA pour calculer les périodes
Réponses
6
Affichages
201
bsalv
B
P
  • Résolu(e)
Microsoft 365 DATEDIF
Réponses
11
Affichages
219
Payne
P
A
  • Question Question
XL 2010 Problème ou alternative à SOMPRODUCT en VBA
Réponses
14
Affichages
515
bruno lemaire
B
J
  • Question Question
XL 2016 Code VBA pour éclater un fichier en x fichier par mois
2 3
Réponses
36
Affichages
534
vgendron
vgendron
D
  • Question Question
Microsoft 365 Copier avec liaison mais en intégrant les mois de production
Réponses
1
Affichages
132
sioum
S
P
  • Résolu(e)
XL 2021 Requête API - VBA Excel - Parse JSON
Réponses
2
Affichages
421
picc
P
P
  • Question Question
XL 2016 Convertir un nombre en année, mois et jours
Réponses
8
Affichages
2 K
Patrick BRZ
P
R
  • Résolu(e)
XL 2019 Convertir date en mois et année par macro
Réponses
5
Affichages
512
Rabeto
R
J
  • Question Question
XL 2021 Macro : avoir les mois en chiffres de 1 à 12 en colonne à chaque ligne différente
Réponses
5
Affichages
460
jerome91
J
C
  • Résolu(e)
XL 2019 Recherchev avec même valeur
Réponses
5
Affichages
299
job75
job75
D
  • Question Question
Microsoft 365 Code VBA pour date DD/MM/YYYY
Réponses
6
Affichages
392
Staple1600
Staple1600
A
  • Question Question
XL 2016 Exclure une période des calcule de jours entre 2 dates (Datedif)
Réponses
2
Affichages
816
job75
job75
E
  • Question Question
Microsoft 365 Problème de conversion des mois en périodes dans Excel avec VBA
Réponses
2
Affichages
674
RyuAutodidacte
RyuAutodidacte
F
  • Question Question
XL 2016 Calculer la différence entre deux dates en mois
Réponses
5
Affichages
526
vgendron
vgendron
A
  • Question Question
Microsoft 365 récupérer des valeurs après un filtre en VBA (pour envoyer des emails)
Réponses
6
Affichages
170
aurejotrail
A
C
  • Résolu(e)
XL 2021 planning
Réponses
14
Affichages
1 K
Chavanie21
C
Vidal Salvador
  • Question Question
Microsoft 365 Programmes VBA pour trier
Réponses
8
Affichages
437
Vidal Salvador
Vidal Salvador
oguruma
EXCEL : MakeDirP :: Le mkdir -p de linux reconduit en VBA pour la création d'une arborescence de dossier et sous-dossiers
Réponses
4
Affichages
382
oguruma
oguruma
Retour