Date et heure EcartDate

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Beaucoup de question sur comment calculer l'âge d'une personne à partir de sa date de naissance ou bien le nombre d'année, de mois et de jour entre deux dates.

J'ai repris une fonction de @ROGER2327🙂 qui l'avait lui-même reprise de JP Mesters et j'ai ajouté quelques options.

La fonction : EcartDate(Debut As Date, Fin As Date, Optional Quoi As String = "", Optional Langue As String = ".fr")

Debut est la date de début de la période (c'est une vraie date au sens d'Excel pas du texte)
Fin est la date de début de la période (c'est une vraie date au sens d'Excel pas du texte)
Quoi est ce qu'on désire en sortie :
  • ce paramètre est facultatif
  • si quoi = 1 ou "a" ou "y" alors on retourne un nombre qui est le nombre d'année entre le Debut et la Fin
  • si quoi = 2 ou "m" alors on retourne un nombre qui est le nombre de mois entre le Debut et la Fin
  • si quoi = 3 ou "j" ou "d" alors on retourne un nombre qui est le nombre de jour entre le Debut et la Fin
  • si quoi est omis ou différent des valeurs ci-dessus alors on retourne la durée (âge) en texte sous la forme texte : n an m mois j jour
  • on adapte le texte de sortie avec les singuliers ou pluriels requis.
Langue est un texte indiquant la langue à utiliser :
  • ce paramètre est facultatif
  • cet argument sera égal un court texte commençant par un point et suivi du suffixe internet (pour site du pays de la langue désirée)
  • exemple de texte : .fr (français), .gb (anglais), .uk (anglais), .usa (américain), .de (allemand), .es (espagnol), .it (italien), .pt (portugais), .cor (corse)
  • si Langue est omis ou bien ne correspond pas à une des traductions alors la langue sera le français
Pour ajouter une langue dans le code :
  • dupliquer la dernière ligne de type texte = texte & "," & ".cor,annu,anni,m...
  • remplacer cor par le code du pays parlant la langue désirée
  • puis, séparées par des virgules, indiquer les traductions de an (au singulier puis au pluriel), de mois (au singulier puis au pluriel) et enfin de jour (au singulier puis au pluriel).

Vos avis, critiques et suggestions sont les bienvenues. Il faudrait aboutir à une fonction personnalisée avec un consensus "presque général".
Si c'est une mauvaise idée ou bien redondant alors je retirerai la fonction sans en être marri en aucune manière.:)

Le code est dans module1:
VB:
Function EcartDate(Debut As Date, Fin As Date, Optional Quoi As String = "", Optional Langue As String = ".fr")
' adapté d'un code de -> JP Mesters
Const defaut = ".fr"

Dim texte$, Nba&, Nbm&, Nbj&, Retenue&, s$, t, i&
   If Debut > Fin Then EcartDate = "#CHRONOLOGIE!": Exit Function
   texte = ".fr,an,ans,mois,mois,jour,jours"                         'français (.fr)
   texte = texte & "," & ".gb,year,years,month,months,day,days"      'anglais (.gb)
   texte = texte & "," & ".uk,year,years,month,months,day,days"      'anglais (.uk)
   texte = texte & "," & ".usa,year,years,month,months,day,days"     'américain (.usa)
   texte = texte & "," & ".de,Jahr,Jahre,Monat,Monate,Tag,Tage"      'allemand (.de)
   texte = texte & "," & ".es,año,años,mes,meses,día,días"           'espagnol (.es)
   texte = texte & "," & ".it,anno,anni,mese,mesi,giorno,giorni"     'italien (.it)
   texte = texte & "," & ".pt,ano,anos,mês,meses,dia,dias"           'portugais (.pt)
   texte = texte & "," & ".cor,annu,anni,mese,mesi,ghjornu,ghjorni"  'corse (.cor)
 
   Nba = Year(Fin) - Year(Debut)
   Nbm = Month(Fin) - Month(Debut)
   Nbj = Day(Fin) - Day(Debut)
   Retenue = Day(DateSerial(Year(Fin), Month(Fin), 0))
   If Nbj < 0 Then Nbm = Nbm - 1: Nbj = Nbj + Retenue
   If Nbm < 0 Then Nba = Nba - 1: Nbm = Nbm + 12

   Select Case Left(LCase(Quoi), 1)
      Case "a", "y", "1"
         EcartDate = Nba: Exit Function
      Case "m", "2"
         EcartDate = Nbm: Exit Function
      Case "j", "d", "3"
         EcartDate = Nbj: Exit Function
      Case Else
         Quoi = LCase(Quoi): Langue = LCase(Langue): t = Split(LCase(texte), ",")
         If Left(Langue, 1) <> "." Then Langue = defaut
         For i = 0 To UBound(t)
            If Langue = t(i) Then Exit For
         Next i
         If i > UBound(t) Then i = 1
         s = IIf(Nba = 0, "", IIf(Nba = 1, "1 " & t(i + 1), Nba & " " & t(i + 2)))
         s = Trim(s & " " & IIf(Nbm = 0, "", IIf(Nbm = 1, "1 " & t(i + 3), Nbm & " " & t(i + 4))))
         s = Trim(s & " " & IIf(Nbj = 0, "", IIf(Nbj = 1, "1 " & t(i + 5), Nbj & " " & t(i + 6))))
   End Select
   EcartDate = s
End Function
 

Pièces jointes

  • calcul âge-v1.xlsm
    25.7 KB · Affichages: 24
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Bonjour Magic_Doctor, mapomme,

c'est pas lui, j'ai vu un post où Yeahou (salut) dit que c'est Office 365 qui met automatiquement des matricielles ; mais il a trouvé une solution : il faut appeler la fonction en mettant une arobase devant le nom, comme ça :

=@EcartDate(...)



j'ai retrouvé le post de Yeahou dont j'ai parlé : c'est ICI. :)

soan
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Magic_Doctor 🙂, @soan :),

Je n'ai rien validé en matriciel. Sur 365, aucune notation matricielle.
D’ailleurs la fonction personnalisée ne prend aucune matrice ou plage en entrée et ne retourne pas une matrice non plus.
Sur quelle colonne, voyez vous cela ?
 
Dernière édition:
Bonjour Mapomme, Magic_Doctor, le forum

@Magic_Doctor , j'ai compris pourquoi tu voyais des matricielles dans mes fonctions, 365 met des matricielles automatiquement, qui ne se voient que sur les versions antérieures. J'ai eu le cas rapporté aussi avec Omega Hour. Pour que les matricielles ne se créent pas en auto sous 365, il faut que j'ajoute un @ entre le = et la fonction.
C'est transparent sur les versions antérieures qui, sinon, voient les matricielles auto de 365 qui sont invisibles sous 365, plutôt casse pied cette différence de versions.

Bien cordialement, @+
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

J'ai sauvegardé le fichier en .xls (Excel 2003):
  • j'ai bien un message d'avertissement concernant la propagation de formule
  • en ouvrant le fichier .xls, j'ai bien des formules matricielles (d'ailleurs inutiles) dans les colonnes C à F
1621723278401.png
 

Pièces jointes

  • calcul âge-v1.xls
    58 KB · Affichages: 7
Dernière édition:
Bonjour @mapomme , le fil, le forum

Après tests, la matricielle dynamique est quasi systématique avec les fonctions personnalisées.
ce simple code en déclenche une !
VB:
Function TestMatricielleAuto(arg1)
TestMatricielleAuto = arg1
End Function
Le seul truc que j'ai trouvé pour la désactiver, après avoir examiné des fichiers avec et sans matricielles enregistrées sur des versions antérieures, est comme je l'ai dit de placer @ entre le = et la formule, plus de matricielle, le fichier est compatible et les @ sont invisibles sur les versions antérieures.
=@TestMatricielleAuto(A1)
Refais ton test du post précédent avec cette astuce et ton fichier s'enregistrera sans problème et sans matricielle.

Bien cordialement, @+
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Refais ton test du post précédent avec cette astuce et ton fichier s'enregistrera sans problème et sans matricielle.
bonjour @Yeahou ;),

Effectivement. Ça le fait.

En réalité, ça ne gêne en rien le bon fonctionnement dans les versions antérieures.

Le seul fait troublant, c'est qu'un utilisateur peut (à juste raison) se demander la raison de cette validation matricielle.

Je me refuse à modifier mes formules 365 par l'ajout d'un @ juste parce que Krosoft n'a pas réussi à faire un travail de rétrocompatibilité jusqu'au bout et par conséquent confié à l’utilisateur le soin de le faire à la mimine.

D'un autre côté, je ne vois pas comment anticiper le retour d'une fonction personnalisée qui peut retourner de temps en temps une matrice et de temps en temps un type simple (si, si je l'ai déjà fait). Ça donne l'impression que pour pallier cet obstacle, Krosoft a validé systématique en matricielle les fonctions personnalisées et a délégué à l'utilisateur le soin de la rétro compatibilité transparente complète. Mais ce n'est qu'une impression.

Le développement d'un programme et les ajouts de fonctionnalité ne permettent pratiquement jamais une rétrocompatibilité totale. C'est le prix à payer pour disposer de fonctions plus évoluées, plus faciles à utiliser au fil du temps. Dans ce cas, admettons que Krosoft a malgré tout assuré cette rétrocompatibilité au moyen d'une "astuce" qui fonctionne.

Pour une entreprise, je pense qu'il est toujours très couteux de consacrer quantités d'homme-mois de développement juste pour assurer une rétrocompatibilité poussée le plus loin possible :
  • la rétrocompatibilité n'est pas motivante pour le personnel (travail sur le passé!)
  • ça concerne des versions qui à terme (même lointain) disparaitront
  • le retour sur investissement (moyens consacrés) est quasi nul
  • la concurrence pousse à introduire des fonctions supplémentaires pour rester compétitif
  • ces concurrent nouveaux et innovateurs n'ont pas le problème de compatibilité avec n+1 anciennes versions de leur logiciel
En tant qu'entreprise, il faut savoir quand "arrêter".
 
Dernière édition:
Ça donne l'impression que pour pallier cet obstacle, Krosoft a validé systématique en matricielle les fonctions personnalisées et a délégué à l'utilisateur le soin de la rétro compatibilité transparente complète. Mais ce n'est qu'une impression.
Bonjour @mapomme

"Je dirais même plus, c'est mon avis et je le partage !" dixit Dupont et Dupond.

Bien cordialement, @+
Bernard
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bonjour @mapomme

pas mal du tout
j'au rait fait légèrement différemment pour les langues
d'une par parce que le split du texte va peser si des millier de ligne avec formule alors qu'un select case sera certainement plus rapide
par la même occasion j'aurais mis la détection de langue automatique
tout simplement comme suit
VB:
Option Explicit

Function EcartDate(Debut As Date, Fin As Date, Optional Quoi As String = "", Optional Langue As String = "")
' adapté d'un code de -> JP Mesters
If Langue = "" Then Langue = Application.International(xlCountrySetting)
Select Case LCase(Langue)
Case 33, ".fr": texte = "an,ans,mois,mois,jour,jours"
Case 49, ".de": texte = ".de,Jahr,Jahre,Monat,Monate,Tag,Tage"
Case 34, ".es": texte = "año,años,mes,meses,día,días"
Case 1, 44, XX, ".uk", ".gb", ".usa": texte = "year,years,month,months,day,days"
Case ".it", XX: texte = "anno,anni,mese,mesi,giorno,giorni"
Case ".pt", XX: texte = "ano,anos,mês,meses,dia,dias"
Case ".cor": texte = "annu,anni,mese,mesi,ghjornu,ghjorni"

Case Else: texte = "an,ans,mois,mois,jour,jours" ' on le met par defaut en francais au cas ou la langue n'est pas retrouvée
End Select
'blablabla'
et plus bas je modifierais ton split

et quoi que dans le select case j'aurais mis des array directement
comme ca tout le code du split disparaît

remplacer les "XX" par les codes countrycode ( je ne retrouve plus ma liste )
on gagnerais en perte de poid et lourdeur de fonctionnement( donc plus rapide )

;)
 

Discussions similaires

  • Question
Microsoft 365 Excel VBA
Réponses
14
Affichages
790

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
315 097
Messages
2 116 186
Membres
112 679
dernier inscrit
Yupanki