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" ?

 

[Magic_Doctor]

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

Bonjour à tous,

Je me suis penché sur toutes les solutions en présence. Toutes coïncident sauf à quelques exceptions près. Évidemment, là où l'on rencontre des problèmes c'est dans les années bissextiles, avec les 28 et 29 février.
J'ai ainsi repéré des dates à problèmes. Par exemple :
28/02/2000 --> 31/03/2003
29/02/2000 --> 31/03/2003
28/02/2000 --> 28/02/2003
28/02/2000 --> 28/02/2000
29/02/2000 --> 29/02/2004
29/02/2000 --> 28/02/2004

J'ai corrigé ma fonction en conséquence. Les fonctions que vous avez apportées sont encore trop sophistiquées pour moi pour que je puisse les modifier moi-même. Quant aux formules, ¡caramba! je ne cherche même pas à comprendre : je copie et je colle en me démerdant pour que les cellules d'arrivée soient les mêmes que celles d'origine.

job (post #38) signale qu'il y a un problème avec le "fameux 29/02/1900". En effet, curieusement les grosses têtes de chez Microsoft ont oublié que 1900 n'était pas, contre toute attente, une année bissextile (il n'y a pas si longtemps que ça, moi aussi je ne la savais pas...), ce qui fait que cette fonction n'est pas universelle pour uniquement le 29/02/1900. En revanche, Excel reconnaît les années bissextiles qui ne le sont en fait pas comme 2100.
Bon, concernant ce problème de l'année 1900, personnellement cela ne me dérange pas outre mesure. Il est, ma foi, rare, quand on n'est ni historien ni archéologue ni science-fictionniste, de faire des calculs en dehors des XXème et XXIème siècles.

 

[Modeste geedee]

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

Bonsour®

Bonjour à tous,

Je me suis penché sur toutes les solutions en présence. Toutes coïncident sauf à quelques exceptions près. .

Coïncident ???
aucune ne répond à :

Ne restent plus que quelques jours : ceux allant du jour de la 1ère date jusqu'à la fin du mois de celle-ci et le nombre de jours de la 2ème date. La somme de ces jours sera le nombre de jours restant qui au maximum aura pour valeur 60

https://www.excel-downloads.com/thr...de-temps-pour-des-annees-de-365-jours.213338/


je rajoute donc à la compilation ma proposition (formule)

 

[mapomme]

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

Bonjour à tous ,

Bon, je m'y mets aussi. Rien de bien neuf sous le soleil . J'y suis allé en VBA à la hache et à la masse , et avec un dictionnaire aussi!!!! Je n'ai pas regardé à la dépense .

Le principe:

• on met dans un dico tous les jours du début à la fin incluse, sauf si ce sont des 29 février.
• On boucle sur les mois complets pour le comptage des mois (calcul des début et fin de mois de chaque mois complet - si la la fin de mois est un 29 fév. on la passe au 28 fév.)
• si le début et la fin du mois complet sont dans le dico, alors on ôte du dico tous les jours de ce mois.
• Quand on a passé en revue tous les mois complets susceptibles de se trouver dans le dico, alors il n'y reste plus que le nombre de jours isolés.
• On fait, éventuellement si on veut le compter, une correction du nombre de jour si le 1ier jour est un 29 fév.

Je trouve, à peu de choses près, des résultats analogues, sauf avec les années bissextiles et en particulier si la date de début est un 29 février. Avec ma méthode, tous les 29 février n'existent pas (puisque année de 365 jours) et sont tués avant comptage.

A ce propos, les deux conditions suivantes, me semble-t il, s'excluent mutuellement:

• les années ont toutes 365 jours (on ne tient donc jamais compte des années bissextiles)
• le jour de la 1ère date est toujours inclus

Donc si la 1ière date est un 29 février, que fait on ?
Pour ma fonction, je laisse le choix. Si le troisième paramètre est à VRAI, on comptera le 29 février si c'est la 1ière date:
Function DifDat365(ByVal D, ByVal F, D29fev As Boolean)

Le code:

Function DifDat365(ByVal D, ByVal F, D29fev As Boolean)
Dim dico As New Scripting.Dictionary, i&, j&, dd&, ff&, mm&, chouia&

For i = D To F 'tous les jours sauf les 29 fév
  If Not (Day(i) = 29 And Month(i) = 2) Then dico(i) = ""
Next i
dd = IIf(Day(D) <> 1, DateSerial(Year(D), Month(D) + 1, 1), D) ' 1ier début de mois
ff = DateSerial(Year(dd), Month(dd) + 1, 1) - 1 'fin du mois
If Day(ff) = 29 And Month(ff) = 2 Then ff = ff - 1 'si 29 fév passer au 28 fév
For i = 0 To 12 * (Year(F) - Year(D) + 1) 'comptage mm des mois complets
  If dico.Exists(dd) And dico.Exists(ff) Then 'le mois est inclus dans dico
    mm = mm + 1
    For j = dd To ff: dico.Remove j: Next j 'on retire le mois du dico
  End If
  dd = DateSerial(Year(dd), Month(dd) + 1, 1) 'début du mois suiv.
  ff = DateSerial(Year(dd), Month(dd) + 1, 1) - 1 'fin du mois suiv.
  If Day(ff) = 29 And Month(ff) = 2 Then ff = ff - 1 'si 29 fév passer au 28 fév
Next i
If Day(D) = 29 And Month(D) = 2 And D29fev Then chouia = 1
DifDat365 = Trim(IIf(mm \ 12 = 0, " ", mm \ 12 & IIf(mm \ 12 < 2, " an ", " an(s) ")) & _
  IIf(mm - 12 * (mm \ 12) = 0, " ", mm - 12 * (mm \ 12) & " mois ") & _
  IIf(dico.Count + chouia = 0, "", dico.Count + chouia & IIf(dico.Count + chouia < 2, " jour", " jour(s)")))
End Function

@Modeste geedee : un p'ti hic pour début et fin proches.

 

[job75]

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

Bonjour mapomme, le fil,

Bravo, ton fichier compare même les solutions par formules !

Ma solution par formules donne toujours un résultat exact, même avec le 29/02/1900, voir mon post #38.

A+

 

[mapomme]

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

Bonjour Job75 , le forum,

(...) ton fichier compare même les solutions par formules ! Ma solution par formules donne toujours un résultat exact, même avec le 29/02/1900, voir mon post #38. (...)

C'est bravo à Modeste geedee . C'est son fichier que j'ai honteusement piraté .

Ma fonction (avec le 3ième paramètre égal à vrai) aboutit à des résultats identiques aux tiens à une expression près.

Si le jour de début fait parmi d'un mois de février à 29 jours, tu sembles compter ce premier 29 février. Ma fonction exlut ce 29 février pour respecter la condition n° 1 du post #1, sauf dans le cas où la date de début est elle-même un 29 fév. pour respecter la condition n° 3.

Enfin tout ceci n'est qu'une question d'interprétation (j'en suis resté au post #1 pour les hypothèses)

 

[job75]

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

Re mapomme,

Inclure ou exclure comme tu le fais le 29 février ne me paraît pas cohérent.

Le 29 février doit simplement toujours donner le même résultat que le 28 février.

A+

 

[mapomme]

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

(re) Bonjour job75,

(...) Inclure ou exclure comme tu le fais le 29 février ne me paraît pas cohérent. (...)

Je me rends à ta remarque avec bonne volonté

@+

 

[Modeste geedee]

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

Bonsour®

Enfin tout ceci n'est qu'une question d'interprétation (j'en suis resté au post #1 pour les hypothèses)

Hypothèses qu'il faudrait alors affiner...
- qu'appelle-t-on année ? :
période 1 Janv au 31 Déc
ou bien
période de 12 mois complets consécutifs.

- début inclus :
dans le cas du jour 1 : cela signifie-t-il que le mois est complet ?
- fin inclus :
si c'est le dernier jour du mois (28,29,30 ou 31 selon le cas) le mois est-il considéré complet ?

de la même façon que l'on admet que :
- la somme des jours n'appartenant pas à un mois complet puisse dépasser 31 et aller jusque 60,
- la somme des mois n'appartenant pas à une année complète peut alors dépasser 12 jusque 22.

On ne sait pas bien ce qu'on cherche, mais on s'amuse bien !
Continuons !

 

[mapomme]

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

Bonjour Modeste geedee

Bonsour®


Hypothèses qu'il faudrait alors affiner...
- qu'appelle-t-on année ? :
période 1 Janv au 31 Déc
ou bien
période de 12 mois complets consécutifs.

- début inclus :
dans le cas du jour 1 : cela signifie-t-il que le mois est complet ?
- fin inclus :
si c'est le dernier jour du mois (28,29,30 ou 31 selon le cas) le mois est-il considéré complet ?

de la même façon que l'on admet que :
- la somme des jours n'appartenant pas à un mois complet puisse dépasser 31 et aller jusque 60,
- la somme des mois n'appartenant pas à une année complète peut alors dépasser 12 jusque 22.

Moi, je ne sais pas, je ne sais plus, je ne sais plus...

 

[VIARD]

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

Bonjour à tous

J'ai parcouru rapidement le sujet, peut-être un peu trop rapide.
Il y a quelques années, j'ai réalisé une petite Sub pour faire le delta entre deux dates.
Elle me donne satisfaction pour ce que j'en fais. C'est un travail personnel.
Alors histoire de mettre un peu d'eau au moulin, je vous présente ma sub.
Donc vous trouverez sûrement des lacunes! par rapport aux fonctions utilisées ici.

Sub Age()
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 = Cells(4, 2).Value
CeJ = Format(Cejour, "dd-mm-yyyy")
Nais = Cells(3, 2).Value
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 -----------
Label8.Caption = Age & " an(s) " & NbM & " mois et " & NbJ & " Jour(s)"

End Sub

l'année bissextile n'est pas traitée.
Mon code est brut de fonderie et n'a pas été remanié depuis.

Salutations à tous

Jean-Paul

 

[job75]

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

Re,

Chez moi c'est simple :

- période comptabilisée => de la 1ère date à la seconde date, toutes deux incluses

- mois complet => du 1er au dernier jour de chaque mois de la période (le 28 ou le 29 février c'est pareil)

- années => nombre de 12 mois complets consécutifs de la période

- mois => nombre de mois complets restants non comptés dans les années

- jours => nombre de jours des mois incomplets, les 29 février n'étant pas comptés.

A+

 

[Magic_Doctor]

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

Bonjour,

J'ai à nouveau modifié ma fonction...
Jusqu'à présent la solution qui coïncide le plus avec mes desiderata est celle de mapomme (pour "VBA (vrai)"). Chapeau pour cette fonction !
Concernant la question de mapomme, à savoir ce que l'on fait si la date de départ est un 29 février. Personnellement, puisque je suis à l'origine du fil, je vois les choses ainsi. Si la date de mise en service d'un actif est (exceptionnellement !) un 29 février, et bien c'est un 29 février et pas autre chose. Soyons logique (même si l'administration ne raisonne pas comme ça, je m'en fous), une entreprise qui ferme le dimanche met en service une machine un 29 février qui est un lundi, difficile de faire croire que la machine a été mise en service pour la 1ère fois le jour de la fermeture. Donc, dans ce cas-là, il faut conserver le 29 février au départ. Idem pour la 2ème date. On décide, pour une raison quelconque, de sortir prématurément d'un amortissement un 29 février, et bien on sort le 29 et pas le 28. En dehors de ces 2 exceptions, tous les 29 février sont purgés, même si la date de mise en service est le 28 février d'une année bissextile.

Modeste geedee. Par année j'entends 12 mois consécutifs quels qu'ils soient. Par mois complet, tout intervalle de temps qui aille du 1er inclus d'un mois donné jusqu'à son dernier jour inclus lui aussi (28 / 30 / 31 suivant les mois d'une année de 365 jours). Si, pour la 2ème date, le jour du mois correspond au dernier jour dudit mois dans le calendrier (d'années de 365 jours), le mois sera alors complet. Il en ira de même avec le mois de la 1ère date si celui-ci est un 1er.
En fait il s'agit de si la somme des jours appartenant à des mois incomplets (mois de la 1ère date et mois de la 2ème date) puisse dépasser 31 et aller jusqu'à 60.

PS : j'ai un chouïa relooké le résultat de la fonction de mapomme.

 

[Magic_Doctor]

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

Bonjour,

J'ai repéré une discordance, par exemple :
15/05/2000 --> 25/05/2009
15/05/2000 --> 15/05/2009 : 9 ans
15/05/2009 --> 25/05/2009 : 11 jours
Bilan : 9 ans / 11 jours

 

[Victor21]

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

Bonjour, M_D, bonjour à tous

J'ai repéré une discordance, par exemple :
15/05/2000 --> 25/05/2009
15/05/2000 --> 15/05/2009 : 9 ans
15/05/2009 --> 25/05/2009 : 11 jours
Bilan : 9 ans / 11 jours

Vous comptez deux fois le 15/5/2009 ?

 

[Magic_Doctor]

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

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.