Microsoft 365 Convertir en VBA

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion PORCHER
  • Date de début Date de début

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
PORCHER

PORCHER

XLDnaute Occasionnel
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
 
Trier par date Trier par votes
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:
Vote positif 0 Vote négatif
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)))
 
Vote positif 0 Vote négatif
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

@+
 
Vote positif 0 Vote négatif
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
Cliquez pour agrandir...
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))
Cliquez pour agrandir...
Bonjour @Dranreb ,
Ta fonction renvoie 18,05. Je trouve 18,0322580645161 ? et @PORCHER :18,129 🙂
Daniel
 
Vote positif 0 Vote négatif
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

@+
 
Vote positif 0 Vote négatif
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 ?
 
Vote positif 0 Vote négatif
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. 🙂
 
Vote positif 0 Vote négatif
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

Dernière édition:
Vote positif 0 Vote négatif
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.
 
Vote positif 0 Vote négatif
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
 
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

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
116
BenHarber
BenHarber
K
  • Verrouillé
  • Résolu(e)
XL 2016 [Résolu]Calculer l'ancienneté en prenant en compte l'interruption
Réponses
10
Affichages
823
Kirill95
K
G
  • Question Question
Microsoft 365 Convertir CSV en tableau de nombres
Réponses
7
Affichages
211
sylvanu
sylvanu
R
  • Résolu(e)
XL 2019 Convertir date en mois et année par macro
Réponses
5
Affichages
452
Rabeto
R
E
  • Question Question
Microsoft 365 Problème de conversion des mois en périodes dans Excel avec VBA
Réponses
2
Affichages
598
RyuAutodidacte
RyuAutodidacte
J
  • Question Question
XL 2021 Macro : avoir les mois en chiffres de 1 à 12 en colonne à chaque ligne différente
Réponses
5
Affichages
371
jerome91
J
D
  • Question Question
XL 2016 VBA - Datedif bugguée ?
Réponses
8
Affichages
1 K
patricktoulon
patricktoulon
D
  • Résolu(e)
XL 2016 VBA Evaluate
2 3 4
Réponses
45
Affichages
4 K
soan
S
M
  • Résolu(e)
Microsoft 365 VBA-Conversion formules en valeurs/condition date
Réponses
7
Affichages
781
Jacky67
Jacky67
M
  • Question Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
646
marie3107
M
N
  • Résolu(e)
XL 2021 erreur Vba
2
Réponses
21
Affichages
2 K
Oneida
Oneida
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
2 K
un internaute
U
Chaton0408
  • Question Question
Microsoft 365 VBA Création Question liste destinataire
Réponses
6
Affichages
462
youky(BJ)
youky(BJ)
A
  • Question Question
XL 2019 Tri plage + arrondis montants en VBA
Réponses
4
Affichages
495
Amilo
A
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
644
Nico2978
Nico2978
T
  • Résolu(e)
XL 2010 Formule dans cellule -> formule VBA
Réponses
5
Affichages
490
tchi456
T
S
  • Question Question
XL 2019 Enregistrer plusieurs feuilles excel en un fichier PDF dans un dossier portant le nom d'une cellule
Réponses
4
Affichages
2 K
Phil69970
Phil69970
C
  • Résolu(e)
XL 2013 Conversion de feuilles excel en txt automatisée sous VBA (MAIS pb du format date en anglais)
Réponses
7
Affichages
872
Chrystel01
C
M
  • Résolu(e)
Microsoft 365 VBA pour transformer une plage en tableau + Générer un tableau de synthèse
Réponses
10
Affichages
662
Merlin258413
M
A
  • Question Question
Microsoft 365 Convertir code Pyhton en VBA (convert Python to VBA)
Réponses
11
Affichages
2 K
dysorthographie
dysorthographie
Retour