Microsoft 365 Convertir en VBA

PORCHER · 17 Octobre 2020

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 · 17 Octobre 2020

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))

danielco · 17 Octobre 2020

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)))

Compte Supprimé 979 · 17 Octobre 2020

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 · 17 Octobre 2020

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)))

sylvanu à dit:
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

Dranreb à dit:

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

sylvanu · 17 Octobre 2020

@danielco,
Avec 16/04/2019 et 17/10/2020, on trouve 18.03 (18.0322581) que ce soit soit par XL (Porcher) soit par Macro (moi)
Normal c'est strictement la même chose ( avec formula R1C1 )

Compte Supprimé 979 · 17 Octobre 2020

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 · 17 Octobre 2020

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 ?

sylvanu · 17 Octobre 2020

Bonsoir Dranreb,
Pas d'accord. XL répond 18.03 car il travaille en unités : année, mois, jours.
Un an c'est 1, que cette année ait eu 365 ou 366 jours.
Un mois c'est 1/12, que ce mois ait eu 28,29,30 ou 31 jours.
Heureusement, sinon quelle galère pour vous souhaiter votre anniversaire.

Dranreb · 17 Octobre 2020

Pour obtenir ce que vous dites j'aurais simplement divisé le nombre de jours qui sépare celle du jour de naissance par 30,436875
Là oui, on a une durée indépendante des dates.

mapomme · 18 Octobre 2020

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%) !

Dranreb · 18 Octobre 2020

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 · 18 Octobre 2020

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

danielco · 18 Octobre 2020

Bonjour @PORCHER , bonjour à tous,

J'ai bâti ma solution sur DATEDIF. Il s'avère que cette fonction est buggée. Il ne faut donc pas la prendre en considération. Il y a eu plusieurs autres réponses à ta question au cours de cette discussion. A toi de choisir.

Daniel

PORCHER · 18 Octobre 2020

Voici ci-joint mon classeur
Modification possible

Compte Supprimé 979 · 18 Octobre 2020

PORCHER à dit:
Voici ci-joint mon classeur
Modification possible

Bonjour Jean-Yves, ton VBA Project est protégé par mot de passe !?

Microsoft 365 Convertir en VBA

PORCHER

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

danielco

XLDnaute Accro

Compte Supprimé 979

Guest

danielco

XLDnaute Accro

sylvanu

XLDnaute Barbatruc

Compte Supprimé 979

Guest

Dranreb

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

PORCHER

XLDnaute Occasionnel

danielco

XLDnaute Accro

PORCHER

XLDnaute Occasionnel

Pièces jointes

Compte Supprimé 979

Guest

Discussions similaires