Fonction qui dissèque un intervalle de temps pour des années de 365 jours

[Magic_Doctor]

Bonjours,

J'ai essayé de résoudre le problème suivant : convertir en année(s) / mois COMPLET(S) / jour(s) le nombre de jours qu'il y a entre 2 dates.
Quelques conditions :
- les années ont toutes 365 jours (on ne tient donc jamais compte des années bissextiles)
- les mois sont toujours complets (fatalement les jours pourront parfois avoir plus de 31 jours suivant les dates)
- le jour de la 1ère date est toujours inclus

J'ai rédigé une fonction obèse-poussive-tordue-spaghetti, mais qui, ma foi, a l'air de marcher :

Function DissectionTemps(dat1 As Date, dat2 As Date) As String
'Magic_Doctor
Dim nba As Integer, m1 As Integer, m2 As Byte, j1 As Byte, j2 As Byte, x As Byte
Dim mesmois As Variant, i As Byte
Dim nbtjr As Integer, nbjr As Integer
Dim nbjmr As Integer, nbjmr1 As Integer, nbjmr2 As Integer
Dim nbmr As Byte, nbmr1 As Byte, nbmr2 As Byte
Dim sentence1 As String, sentence2 As String, sentence3 As String
Dim suf1 As String, suf2 As String, slash1 As String, slash2 As String

j1 = Day(dat1): j2 = Day(dat2)
m1 = Month(dat1): m2 = Month(dat2)

If m2 < m1 Or m2 = m1 And j2 < j1 Then x = 1
nba = Year(dat2) - Year(dat1) - x 'nombre d'années entre les 2 dates
nbtjr = dat2 - DateSerial(Year(dat1) + nba, m1, j1) 'nombre total de jours restant depuis dat1 + nba jusqu'à dat2
mesmois = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) 'mois d'une année de 365 jours

If Month(dat1) < Month(dat2) Then
    nbmr = Abs(m1 - m2 + 1) 'nombre de mois complets restant
    For i = m1 To m2 - 2
        nbjmr = nbjmr + mesmois(i) 'nombre de jours dans les mois complets restant
    Next
    nbjr = nbtjr - nbjmr + 1 'nombre de jours restant
    
    If Day(dat1) = 1 Then 'si le jour de "dat1" est un 1er du mois
        nbmr = nbmr + 1
        nbjmr = nbjmr + NbJoursDuMois(CInt(m1))
        nbjr = nbtjr - nbjmr + 1
    End If
    
    If Day(dat2) = NbJoursDuMois(m2) Then 'si le jour de "dat2" est une fin de mois
        nbmr = nbmr + 1 'nombre de mois complets restant
        nbjr = nbjr - NbJoursDuMois(m2) 'nombre de jours restant
    End If
End If

If Month(dat1) = Month(dat2) Then
    If Day(dat1) < Day(dat2) Then
        nbmr = IIf(Day(dat1) = 1 And Day(dat2) = NbJoursDuMois(CInt(m1)), 1, 0) 'nombre de mois complets restant
        nbjr = IIf(Day(dat1) = 1 And Day(dat2) = NbJoursDuMois(CInt(m1)), 0, nbtjr) 'nombre de jours restant
    ElseIf Day(dat1) = Day(dat2) Then
        nbjr = 0
    Else
        For i = m1 To 11
            nbjmr1 = nbjmr1 + mesmois(i) '1ère tranche du nombre de jours dans les mois complets restant
        Next
    
        For i = 0 To m2 - 2
            nbjmr2 = nbjmr2 + mesmois(i) '2ème tranche du nombre de jours dans les mois complets restant
        Next
        nbmr = 11 'nombre de mois complets restant
        nbjmr = nbjmr1 + nbjmr2 'nombre de jours dans les mois complets restant
        nbjr = nbtjr - nbjmr 'nombre de jours restant
    End If
End If

If Month(dat1) > Month(dat2) Then
    For i = m1 To 11
        nbjmr1 = nbjmr1 + mesmois(i) '1ère tranche du nombre de jours dans les mois complets restant
    Next
    nbmr1 = 12 - m1
    
    If Day(dat1) = 1 Then 'si le jour de "dat1" est un 1er du mois
        nbmr1 = nbmr1 + 1
        nbjmr1 = nbjmr1 + NbJoursDuMois(CInt(m1))
    End If
    
    If Month(dat2) = 1 Then 'le mois de "dat2" est janvier
        If Day(dat1) = 1 Then 'si le jour de "dat1" est un 1er du mois
            nbmr = 13 - Month(dat1)
            nbjr = Day(dat2)
        Else
            nbmr = nbmr1
            nbjr = nbtjr - nbjmr1 + 1
        End If
        GoTo after
    End If
    
    For i = 0 To m2 - 2
        nbjmr2 = nbjmr2 + mesmois(i) '2ème tranche du nombre de jours dans les mois complets restant
    Next
    nbmr2 = Month(dat2) - 1 '2ème tranche du nombre de jours dans les mois complets restant
    nbmr = nbmr1 + nbmr2 'nombre de mois complets restant
    nbjmr = nbjmr1 + nbjmr2 'nombre de jours dans les mois complets restant
    nbjr = nbtjr - nbjmr 'nombre de jours restant
after:
    If Day(dat2) = NbJoursDuMois(m2) Then 'si le jour de "dat2" est une fin de mois
        nbmr = nbmr + 1 'nombre de mois complets restant
        nbjr = nbjr - NbJoursDuMois(m2) 'nombre de jours restant
    End If
    If Day(dat1) = 1 And Day(dat2) = NbJoursDuMois(m2) Then 'si le jour de "dat1" est le 1er d'un mois et le jour de "dat2" est une fin de mois
        If nbmr = 12 Then nbmr = 11: nbjr = NbJoursDuMois(m2)
    End If
End If
    
'*************************** Éléments de la chaîne ***************************
    suf1 = IIf(nba > 1, "s", "")
    suf2 = IIf(nbjr > 1, "s", "")
    sentence1 = IIf(nba = 0, "", nba & " an" & suf1)
    sentence2 = IIf(nbmr = 0, "", nbmr & " mois")
    sentence3 = IIf(nbjr = 0, "", nbjr & " jour" & suf2)
    slash1 = IIf(sentence1 = "" Or sentence2 = "", "", " / ")
    slash2 = IIf(sentence1 = "" And sentence2 = "" Or sentence2 = "" And sentence3 = "" Or sentence2 <> "" And sentence3 = "", "", " / ")
'*****************************************************************************
DissectionTemps = sentence1 & slash1 & sentence2 & slash2 & sentence3
End Function
'-----------------------------------------------------------------------------------------------
Function NbJoursDuMois(m As Byte, Optional année As Integer = 0) As Byte
'Renvoie le nombre de jours d'un mois en fonction de son Nº
'- m : un Nº de mois (janvier --> 1 ... décembre --> 12)
'- année : si omis, ne tiendra pas compte des années bissextiles (février -2- aura toujours 28 jours)
'Magic_Doctor
    Dim mesmois As Variant, x As Byte, nbjoursmois As Byte
    
    x = IIf(année = 0, 28, IIf(LeapYear(année), 29, 28))
    mesmois = Array(31, x, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
    
    NbJoursDuMois = mesmois(m - 1)
End Function
'-----------------------------------------------------------------------------------------------
Function LeapYear(a%) As Boolean
'Vérifie si une année est bissextile ou pas (tient compte des années théoriquement bissextiles et qui ne le sont en fait pas, comme 1800/1900/2100...)
'- a : une année quelconque
'ROGER2327
    LeapYear = ((a Mod 4) = 0) * (1 + ((a Mod 100) = 0) * (1 + (((a \ 100) Mod 4) = 0)))
End Function

Peut-on "dégraisser ce mammouth" ?

 

[VIARD]

Re : Fonction qui dissèque un intervalle de temps pour des années de 365 jours

Bonjour Victor, Magic_Doctor

Si je peux me permettre avec ma fonction j'obtiens bien 9 ans 0 mois 10 jours

Function DateDelta(Date1 As Date, Date2 As Date) As String
'--- auteur Viard Jean-Paul, Delta entre deux dates (An(s), mois, jour(s))
Dim j%, m%, a%
Dim J1%, M1%, A1%, M2%
Dim Cejour As Date, Nais As Date, CeJ As Variant
Dim Age%, NbM%, NbJ%, Na As Date
Dim LesMois As Variant

'---------- Mise en Forme des Dates ----------
Cejour = Date2
CeJ = Format(Cejour, "dd-mm-yyyy")
Nais = Date1
Na = Format(Nais, "dd-mm-yyyy")

j = Left(CeJ, 2): m = Mid(CeJ, 4, 2): a = Right(CeJ, 4)
M2 = m 'mise en mémoire du mois
J1 = Left(Na, 2): M1 = Mid(Na, 4, 2): A1 = Right(Na, 4)
'--------- Correction du jour suivant le mois ---------
LesMois = Array("", "31", "28", "31", "30", "31", "30", "31", "31", "30", "31", "30", "31")
NbM = 0: NbJ = 0
'--------- Age Traitement année --------
Age = a - A1
'------------ traitement Mois ----------
If m > M1 Then
    NbM = m - M1
ElseIf m < M1 Then
    m = m + 12
    NbM = m - M1
    Age = Age - 1
ElseIf m = M1 Then
    NbM = 0
End If
'----------- Traitement Jours ----------
If j > J1 Then
    NbJ = j - J1
ElseIf j < J1 And NbM <> 0 Then
    j = j + LesMois(M2)
    NbJ = j - J1
    NbM = NbM - 1
ElseIf j < J1 And NbM = 0 Then
    j = j + LesMois(M2)
    Age = Age - 1
    NbM = 11
    NbJ = j - J1
ElseIf j = J1 And NbM = 0 Then
    NbM = 0
    NbJ = 0
End If
'----------- Affichage de l'âge -----------
DateDelta = Age & " an(s) " & NbM & " mois et " & NbJ & " Jour(s)"
End Function

Jean-Paul

 

[Victor21]

Re : Fonction qui dissèque un intervalle de temps pour des années de 365 jours

Re, M_D

Bonsoir Victor,

Je peux me tromper, mais je ne pense pas compter 2 fois le 15/5/2009.
si l'on rajoute 365 jours à 01/01/2001, on tombe sur 01/01/2002. On compte, en fait, à partir du lendemain (inclus) du 1er, autrement dit du 2.
Dans le décompte des années allant du 15/05/2000 au 25/05/2009, le 1er jour n'est pas compté. Ce jour est récupéré dans le décompte du 15/05/2009 inclus au 25/05/2009 inclus.

Tu précisais (post 44)

Quand on amorti c'est à partir du jour de mise en service de l'actif et non pas le lendemain !

J'avoue m'y perdre un poco

 

[Magic_Doctor]

Re : Fonction qui dissèque un intervalle de temps pour des années de 365 jours

Bonsoir VIARD, Victor,

VIARD, votre fonction travaille dans l'intervalle ]DateDébut , DateFin], alors que la mienne dans l'intervalle [DateDébut , DateFin], d'où l'écart de 1 jour entre nos résultats.
Victor, effectivement, quand on amorti c'est à partir du jour de mise en service de l'actif et non pas le lendemain. Voilà pourquoi j'ai un jour de plus que VIARD. Je récupère le 1er jour (ou, si vous préférez le jour "J" de la mise en service) non pas dans le décompte des années mais dans celui des jours.
Si j'utilise mon actif du 01/01/2001 au 01/01/2002, je l'aurais utilisé 366 jours et non pas 365 jours.
Mais je reconnais que ces histoires de dates, c'est un truc qui prend la tête. Le matin, au réveil, à l'improviste, vous me posez ces questions, il y a de fortes chances que je vous réponde "cualquier cosa".

Buenas noches a todos, y mañana será hoy más un día.

 

[Regueiro]

Re : Fonction qui dissèque un intervalle de temps pour des années de 365 jours

Bonsoir à Tous
Pour l'amortissement avec la fonction FRACTION.ANNEE
Voir en PJ sur le tableau de MAGIC-DOCTOR

Bonne Soirée
A+

 

[Modeste geedee]

Re : Fonction qui dissèque un intervalle de temps pour des années de 365 jours

Bonsour®


pour le fun et pour répondre à ce point une petite dernière :

- on compte les jours pour les mois non complet.
- pourquoi alors ne pas utiliser la même logique pour les mois ?
nombre de mois entier pour finir l'année de début + nombre de mois complets écoulés pour l'année de fin
et compter alors le nombre d'années calendaires complètes (Janv-Déc) au lieu du nombre de fois 12 mois complets

 

[Magic_Doctor]

Re : Fonction qui dissèque un intervalle de temps pour des années de 365 jours

Bonjour Modeste geedee,

Je n'ai pas très bien compris vos questions.
Dans ma fonction je compte d'abord les années, ensuite je reporte la 1ère date à la 1ère date + nombre d'années. La "nouvelle" 1ère date est ainsi distante de la 2ème date de moins de 1 an. Je compte alors le nombre de jours séparant ces 2 dernières dates + 1 jour (le jour dit de la mise en service). Je compte ensuite le nombre de mois complets séparant ces 2 dates et je fais la somme de la totalité de leurs jours. Je n'ai plus qu'à retrancher du nombre de jours séparant la "nouvelle" 1ère date de la 2ème date le nombre de jours des mois complets ; j'obtiens ainsi le nombre de jours des mois entamés, à savoir le mois de la 1ère date s'il ne commence pas un 1er et le mois de la 2ème date s'il ne s'achève pas le jour de la fin du mois correspondant.
Mais ça c'est, disons, ma stratégie pour tenter de résoudre ce problème. J'avais ouvert ce fil afin de savoir s'il n'y aurait pas un moyen plus élégant, plus concis (moins lourdingue que ma fonction qui nécessite beaucoup de conditions pour traiter les cas particuliers) pour parvenir aux mêmes résultats. Jusqu'à présent vos interventions m'ont montré que ma fonction se plantait pour certaines dates, ce qui m'a permis de la corriger au fur et à mesure.

 

[Magic_Doctor]

Re : Fonction qui dissèque un intervalle de temps pour des années de 365 jours

Ma fonction-lourdingue ayant l'air de fonctionner (après simplifications dans sa "stratégie"), j'en ai profité pour étendre quelque peu ses possibilités.
Au départ, nous raisonnions sur des années dites fiscales de toujours 365 jours. Mais il existe un autre type d'année (du moins en France), celle dite comptable : année de 360 jours (tous les mois, quels qu'ils soient, ont 30 jours). La fonction peut donc distinguer les années fiscales des comptables, et renvoyer le résultat sous forme de "années / jours" ou de "années / mois / jours".
En fait, en y réfléchissant bien, l'idéal serait des mois de 30 jours avec un mois de février de 35 ou 36 jours, que l'on appellerait, par exemple, "The Big Month".

 

[Magic_Doctor]

Re : Fonction qui dissèque un intervalle de temps pour des années de 365 jours

Bonjour,

Améliorations du raisonnement et des résultats.
Par exemple, pour des années de 365 jours : 15/07/2000 --> 13/05/2003
15/07/2000 --> 14/07/2002 : 2 ans
15/07/2002 --> 13/05/2003 : 9 mois pleins + 17 jours (juillet 2002 : 31 jours) + 12 jours (mai 2003) = 29 jours
Bilan : 2 ans / 9 mois / 29 jours
Même raisonnement pour les années de 360 jours (tous les mois ont 30 jours) :
15/07/2000 --> 14/07/2002 : 2 ans
15/07/2002 --> 13/05/2003 : 9 mois pleins + 16 jours (juillet 2002 : 30 jours) + 12 jours (mai 2003) = 28 jours
Bilan : 2 ans / 9 mois / 28 jours
Pour calculer la totalité des jours, au-delà des années s'il y en a, c'est un peu plus compliqué avec les années de 360 jours (convertir les mois de 31 jours en mois de 30 jours, idem pour février).

 

[Magic_Doctor]

Re : Fonction qui dissèque un intervalle de temps pour des années de 365 jours

Bonjour,

Encore quelques couacs corrigés...
J'espère que ce truc-là va enfin correctement marcher maintenant !