Microsoft 365 Convertir en VBA

PORCHER

XLDnaute Junior
Bonjour,
Je souhaiterais convertir une formule en VBA... voici ci-dessous la macro ;
Nombre de mois entre deux date
zv_Debut = CDate(TextDepart.Value) ' Date de naissance
zv_Fin = CDate(TextDateDuJour.Value) ' Date Aujourdhui

If zv_Fin <= zv_Debut Then
zv_Msg = MsgBox("La date de fin ne peut pas être antérieure à la date de début ...", 48, "Erreur")
Exit Sub
End If

nbre_mois = DATEDIF(zv_Debut;zv_Fin;"m")+(DATEDIF(zv_Debut;zv_Fin;"md")/JOUR(FIN.MOIS(zv_Fin;0)))
Txt_NbMois = FormatNumber(nbre_mois, 2) ' Deux chiffres après la virgule
Pourriez-vous SVP me corriger
Merci
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Je dirais :
VB:
Function AgeEnMois(ByVal DNais As Date) As Double
   Dim DN1er As Date, FMois As Date
   DN1er = DateSerial(Year(DNais), Month(DNais), 1)
   FMois = DateSerial(Year(Date), Month(Date) + 1, 0)
   AgeEnMois = Int(100 * (12 * (Year(Date) - Year(DNais)) + Month(Date) - Month(DNais) + 1) _
      * (Date - DNais) / (FMois - DN1er) + 0.5) / 100
   End Function
Faire Txt_NbMois.Text = AgeEnMois(CDate(TextDepart.Text))
 
Dernière édition:

danielco

XLDnaute Accro
Réponse provisoire utilisant la cellule AA10 (tu peux bien sûr la changer pour toute autre cellule inutilisée :

VB:
[AA10].Formula = "=DATEDIF(""" & Format(zv_Debut, "d/m/yyyy") & """,""" & Format(zv_Fin, "d/m/yyyy") & """,""md"")"
nbre_mois = DateDiff("m", zv_Debut, zv_Fin) + ([AA10] / Day(DateSerial(Year(zv_Fin), Month(zv_Fin) + 1, 0)))
 

BrunoM45

XLDnaute Barbatruc
Salut PORCHER,

Voici la solution au problème de DateDif que j'ai trouvé ;)
VB:
Sub Test()
  Dim zv_debut As Date, zv_fin As Date
  Dim sDateDeb As String, sDateFin As String
  Dim sForm As String
  '
  zv_debut = #4/16/2019#
  ' Convertir la date au format américain + texte
  sDateDeb = Format(zv_debut, "mm/dd/yyyy")
  zv_fin = Date
  ' Convertir la date au format américain + texte
  sDateFin = Format(zv_fin, "mm/dd/yyyy")
  ' Inclure la transformation en date des dates texte... et oui ça marche comme ça ;-)
  sForm = "datedif(" & "datevalue(""" & sDateDeb & """)" & ",datevalue(""" & sDateFin & """),""md"")"
  Debug.Print Application.Evaluate(sForm)
End Sub

@+
 

danielco

XLDnaute Accro
Réponse provisoire utilisant la cellule AA10 (tu peux bien sûr la changer pour toute autre cellule inutilisée :

VB:
[AA10].Formula = "=DATEDIF(""" & Format(zv_Debut, "d/m/yyyy") & """,""" & Format(zv_Fin, "d/m/yyyy") & """,""md"")"
nbre_mois = DateDiff("m", zv_Debut, zv_Fin) + ([AA10] / Day(DateSerial(Year(zv_Fin), Month(zv_Fin) + 1, 0)))
Bonjour tout le monde,
Sinon par macro avec FormulaR1C1, bestial mais simple :
VB:
Sub CalcNbMois() ' Macro
    [C3].FormulaR1C1 = "= DATEDIF(zv_Debut,zv_Fin,""m"")+(DATEDIF(zv_Debut,zv_Fin,""md"")/DAY(EOMONTH(zv_Fin,0)))"
    [C3] = [C3].Value
End Sub
Bonjour @sylvanu ,
Effectivement, mais je ne comprends pas pourquoi passer par une cellule. Je en'arrive pas à utiliser Evalua
Bonjour.
Je dirais :
VB:
Function AgeEnMois(ByVal DNais As Date) As Double
   Dim DN1er As Date, FMois As Date
   DN1er = DateSerial(Year(DNais), Month(DNais), 1)
   FMois = DateSerial(Year(Date), Month(Date) + 1, 0)
   AgeEnMois = Int(100 * (12 * (Year(Date) - Year(DNais)) + Month(Date) - Month(DNais) + 1) _
      * (Date - DNais) / (FMois - DN1er) + 0.5) / 100
   End Function
Faire Txt_NbMois.Text = AgeEnMois(CDate(TextDepart.Text))
Bonjour @Dranreb ,
Ta fonction renvoie 18,05. Je trouve 18,0322580645161 ? et @PORCHER :18,129 :)
Daniel
 

BrunoM45

XLDnaute Barbatruc
Re,

Une solution via une fonction
VB:
Sub Test()
  Dim zv_debut As Date, zv_fin As Date
  zv_debut = #4/16/2019#
  zv_fin = Date
  nbre_mois = EvaluateDateDif(zv_debut, zv_fin, "m") + (EvaluateDateDif(zv_debut, zv_fin, "md") / Day(DateSerial(Year(zv_fin), Month(zv_fin) + 1, 1) - 1))
  Debug.Print nbre_mois
End Sub

Function EvaluateDateDif(DateDeb As Date, DateFin As Date, Quoi As String)
  Dim sDateDeb As String, sDateFin As String
  Dim sForm As String
  ' Convertir la date au format américain + texte
  sDateDeb = Format(DateDeb, "mm/dd/yyyy")
  ' Convertir la date au format américain + texte
  sDateFin = Format(DateFin, "mm/dd/yyyy")
  ' Inclure la transformation en date des dates texte... et oui ça marche comme ça ;-)
  sForm = "datedif(" & "datevalue(""" & sDateDeb & """)" & ",datevalue(""" & sDateFin & """),""" & Quoi & """)"
  EvaluateDateDif = Application.Evaluate(sForm)
End Function

@+
 

Dranreb

XLDnaute Barbatruc
Pourtant:
Entre la date du jour et la date de naissance, 19 mois sont couverts.
Le nombre de jours séparant la fin du mois en cours du 1er du mois de naissance est de :
31/10/2020 - 01/04/2019 = 579 jours.
Le nombre de jours séparant la date du jour de la date de naissance n'est que de :
17/10/2020 - 16/04/2019 = 550 jours
Il ne faut donc prendre que 550 / 579 soit 94,9914 % de ces 19 mois, ce qui fait bien 18,0483592 mois, soit, arrondi à 2 décimales 18,05 et non 18,03
Me suis-je planté quelque part ?
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Un essai pour ce que j'en ai compris.

Deux fonctions : nbMois(ddn As Date) et nbJour(ddn As Date)
  • la première donne le nombre de mois complet depuis la date de départ ddn et aujourd’hui. Les mois complets sont les dates anniversaire inférieures ou égales à aujourd'hui
  • la deuxième donne le nombre de jour depuis le lendemain de la dernière date anniversaire de ddn (inférieure ou égale à aujourd'hui) et aujourd’hui
VB:
Function nbMois(ddn As Date)
Dim i&, d As Date
   For i = 0 To 2400
      d = DateSerial(Year(ddn), Month(ddn) + i, Day(ddn))
      If d > Date Then Exit For
   Next
   nbMois = i - 1
   If nbMois < 0 Then nbMois = CVErr(xlErrNA)
End Function

Function nbJour(ddn As Date)
Dim i
   i = nbMois(ddn)
   If IsError(i) Then
      nbJour = CVErr(xlErrNA)
   Else
      nbJour = Date - DateSerial(Year(ddn), Month(ddn) + i, Day(ddn))
   End If
End Function

Ceci n'est qu'une approximation puisque ni l'année, ni le mois ne sont des unités. Seul le jour peut être considéré comme une unité.

Si quelqu'un est né le 31 janvier. A quelle date aura-t-il un mois ? (personnellement, je ne sais pas)
Un nouveau-né né le 01 janvier aura 1 mois le 01/02. Un nouveau-né né le 01 février aura 1 mois le 01/03. le premier aura vécu 31 jours, le second 28 jours (29 les années bissextiles). A un mois chacun, ils auront une différence d'âge égale à 3 jours (soit #10%) !
 

Pièces jointes

  • PORCHER- age en mois et jour- v1.xlsm
    19.4 KB · Affichages: 20
Dernière édition:

Dranreb

XLDnaute Barbatruc
Même en faisant le calcul un peu autrement, je trouve à peu près la même chose :
VB:
Function AgeEnMois(ByVal D1 As Date, Optional ByVal D2 As Date = 0) As Double
   Dim J1&, M1&, A1&, NbJrM1&, J2&, M2&, A2&, NbJrM2
   If D2 = 0 Then D2 = Date
   J1 = Day(D1): M1 = Month(D1): A1 = Year(D1): NbJrM1 = Day(DateSerial(A1, M1 + 1, 0))
   J2 = Day(D2): M2 = Month(D2): A2 = Year(D2): NbJrM2 = Day(DateSerial(A2, M2 + 1, 0))
   AgeEnMois = (NbJrM1 + 1 - J1) / NbJrM1 + 12 * (A2 - A1) + M2 - M1 - 1 + J2 / NbJrM2
   AgeEnMois = Int(AgeEnMois * 100 + 0.5) / 100
   End Function
Je n'ai jamais eu et n'aurai jamais aucune confiance dans le DATEDIF.
 

PORCHER

XLDnaute Junior
Bonjour du Dimanche à tous,
Merci infiniment à tous ceux qui ont apportés des réponses au sujet.
La solution de Daniel
[AA10].Formula = "=DATEDIF(""" & Format(zv_Debut, "d/m/yyyy") & """,""" & Format(zv_Fin, "d/m/yyyy") & """,""md"")"
nbre_mois = DateDiff("m", zv_Debut, zv_Fin) + ([AA10] / Day(DateSerial(Year(zv_Fin), Month(zv_Fin) + 1, 0)))
Le résultat : 19,8709677419355 pour zv_fin = 23/03/2019
ET...
Formule excel : DATEDIF(E28;$C$1;"m")+(DATEDIF(E28;$C$1;"md")/JOUR(FIN.MOIS($C$1;0)))
[E28] = zv_debut
[$C$1] = zv_fin
Le résultat: 18,871
OU EST L'ERREUR!
Merci encore
Amicalement
Jean-Yves
 

Discussions similaires

Réponses
2
Affichages
235

Statistiques des forums

Discussions
290 754
Messages
1 910 207
Membres
176 538
dernier inscrit
Charlydebutant
Haut Bas