Calcul de durées

gimli

XLDnaute Occasionnel
Bonjour à tous,

voilà je débute sur excel et actuellement en stage, et je cherche à calcuer (en minutes) un temps d'interruption , donc j'ai en F1 la date de début de l'interruption en G1 l'heure de début de l'interruption, en H1 la date de ré"tablissement et en I1 l'heure de rétablissement. En J1 je souhaiterai mettre la durée d'interruption en minutes, mais je ne sais comment y parvenir.

PS: j'ai regardé les autres sujets mais tous mettaient l'heure avec la date, moi ces deux informations sont dans une case différente ;)


Merci d'avance ;)

Gimli
 

gimli

XLDnaute Occasionnel
Re : Calcul de durées

Bonjour à tous,
comment je pourrais faire pour faire en sorte de ne prendre en compte sulement les heures et jours ouvrés ? (8h-18h / Du lundi au vendredi)
merci d'avance :)
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Calcul de durées

Bonjour gimli, le fil,

Cette fonction détermine le nombre de minutes entre 2 dates/heures sur les plages horaires 8:00-18:00 du lundi au vendredi :

Code:
Function Minutes(deb As Date, fin As Date) As Long
Dim t1 As Date, t2 As Date, n As Long, d As Date, t As Date
t1 = TimeValue("8:0")
t2 = TimeValue("18:0")
For n = 1 To DateDiff("n", deb, fin)
  d = deb + n / 1440
  t = TimeValue(d)
  If Weekday(d, 2) < 6 And t > t1 And t <= t2 Then Minutes = Minutes + 1
Next
End Function

Je n'aime guère cette solution car le calcul peut prendre beaucoup de temps.

Pour faire quelque chose de mieux, il faudrait se prendre la tête :cool:

A+
 

Pièces jointes

  • test(1).xls
    35 KB · Affichages: 73
  • test(1).xls
    35 KB · Affichages: 74
  • test(1).xls
    35 KB · Affichages: 68

job75

XLDnaute Barbatruc
Re : Calcul de durées

Re,

La déduction des jours fériés allongera notablement le temps de calcul.

Nommer Feries la plage des dates des jours fériés.

La macro modifiée :

Code:
Function Minutes(deb As Date, fin As Date) As Long
Dim t1 As Date, t2 As Date, n As Long, d As Date, t As Date
t1 = TimeValue("8:0")
t2 = TimeValue("18:0")
For n = 1 To DateDiff("n", deb, fin)
  d = deb + n / 1440
  t = TimeValue(d)
  If Weekday(d, 2) < 6 And t > t1 And t <= t2 _
    [COLOR="Red"]And IsError(Application.Match(Int(CDec(d)), [Feries], 0))[/COLOR] _
    Then Minutes = Minutes + 1
Next
End Function

A+
 

Pièces jointes

  • test(2).xls
    36 KB · Affichages: 58
  • test(2).xls
    36 KB · Affichages: 58
  • test(2).xls
    36 KB · Affichages: 60

job75

XLDnaute Barbatruc
Re : Calcul de durées

Re,

Je me suis un peu décarcassé pour améliorer le temps de calcul.

Avec cette macro, il y a un seul test des jours fériés par jour :

Code:
Function Minutes(deb As Date, fin As Date) As Long
Dim t1 As Date, t2 As Date, n As Long, d As Date, t As Date, dat As Long, test As Boolean
t1 = TimeValue("8:0")
t2 = TimeValue("18:0")
For n = 1 To DateDiff("n", deb, fin)
  d = deb + n / 1440
  t = TimeValue(d)
  [COLOR="Red"]If Int(CDec(d)) > dat Then
    dat = Int(CDec(d))
    test = IsError(Application.Match(dat, [Feries], 0))
  End If[/COLOR]
  If Weekday(d, 2) < 6 And t > t1 And t <= t2 [COLOR="red"]And test[/COLOR] Then Minutes = Minutes + 1
Next
End Function

A+
 

Pièces jointes

  • test(3).xls
    36.5 KB · Affichages: 53
  • test(3).xls
    36.5 KB · Affichages: 54
  • test(3).xls
    36.5 KB · Affichages: 54

Modeste

XLDnaute Barbatruc
Re : Calcul de durées

Bonjour à tous,

Je ne sais si gimli repassera par ici ... je voulais juste signaler que j'appréciais (comme beaucoup d'autres, sans doute) quand job75 se "décarcassait".
J'ai failli ajouter "Tu vois, quand tu veux ...!" mais je n'ai pas osé :D
 

job75

XLDnaute Barbatruc
Re : Calcul de durées

Bonjour le fil, le forum,

Bien que ça ne fasse gagner que 9% sur le temps de calcul, je ne peux pas laisser clore ce fil sans cette modif supplémentaire :

Code:
Function Minutes(deb As Date, fin As Date) As Long
Dim t1 As Date, t2 As Date, n As Long, d As Date, t As Date, dat As Long, test As Boolean
t1 = TimeValue("8:0")
t2 = TimeValue("18:0")
For n = 1 To DateDiff("n", deb, fin)
  d = deb + n / 1440
  t = TimeValue(d)
  If Int(CDec(d)) > dat Then
    dat = Int(CDec(d))
    test = [COLOR="Red"]Weekday(d, 2) < 6 And[/COLOR] IsError(Application.Match(dat, [Feries], 0))
  End If
  If t > t1 And t <= t2 And test Then Minutes = Minutes + 1
Next
End Function

Juste une question d'emplacement :eek:

A+
 

Pièces jointes

  • test(4).xls
    36.5 KB · Affichages: 54
  • test(4).xls
    36.5 KB · Affichages: 55
  • test(4).xls
    36.5 KB · Affichages: 53

gimli

XLDnaute Occasionnel
Re : Calcul de durées

Bonjour,

je fais revivre ce topic car j'ai un soucis dans la mise en place de la fonction de job75. J'aimerai savoir s'il est possible que la fonction fonctionne si on ne met pas les jours fériés dans une colonne du tableur mais directement dans la fonction. Il faaudrait je pense déclarer Férié et lui assigner tous les jours fériés, par contre j'ignore le moyen d'y arriver.

Merci d'avance :)


Gimli
 

job75

XLDnaute Barbatruc
Re : Calcul de durées

Bonjour gimli,

Par exemple :

Code:
Function Minutes(deb As Date, fin As Date) As Long
Dim Feries, t1 As Date, t2 As Date, n As Long, d As Date, t As Date, dat As Long, test As Boolean
[COLOR="Red"]Feries = Array(CDbl(CDate("1/1/10")), CDbl(CDate("1/5/10")), CDbl(CDate("14/7/10")), CDbl(CDate("15/8/10")), CDbl(CDate("25/12/10")))[/COLOR]
t1 = TimeValue("8:0")
t2 = TimeValue("18:0")
For n = 1 To DateDiff("n", deb, fin)
  d = deb + n / 1440
  t = TimeValue(d)
  If Int(CDec(d)) > dat Then
    dat = Int(CDec(d))
    test = Weekday(d, 2) < 6 And IsError(Application.Match(dat, [COLOR="red"]Feries[/COLOR], 0))
  End If
  If t > t1 And t <= t2 And test Then Minutes = Minutes + 1
Next
End Function

Dans le tableau, on peut aussi mettre directement les valeurs numériques des date : 40179 etc...

A+
 

gimli

XLDnaute Occasionnel
Re : Calcul de durées

Bonjour à tous,

je souhaiterai savoir si il serait possible d'incrémenter l'année des jours fériés, pour ne pas que tous les ans on soit obligé de modifier la macro pour changer l'année. Je m'adresse en particulier à Job75, auteur de la macro, mais toute aide est bien sûr la bienvenu :)

Function Minutes(deb As Date, fin As Date) As Long
Dim Feries, t1 As Date, t2 As Date, n As Long, d As Date, t As Date, dat As Long, test As Boolean
Feries = Array(CDbl(CDate("1/1/10")), CDbl(CDate("1/5/10")), CDbl(CDate("14/7/10")), CDbl(CDate("15/8/10")), CDbl(CDate("25/12/10")))
t1 = TimeValue("8:0")
t2 = TimeValue("18:0")
For n = 1 To DateDiff("n", deb, fin)
d = deb + n / 1440
t = TimeValue(d)
If Int(CDec(d)) > dat Then
dat = Int(CDec(d))
test = Weekday(d, 2) < 6 And IsError(Application.Match(dat, Feries, 0))
End If
If t > t1 And t <= t2 And test Then Minutes = Minutes + 1
Next
End Function

je pensais faire une boucle for mais je ne sais pas trop comment faire pour gérer le passage d'une année à l'autre :confused:

Merci d'avance,

Gimli
 

Membres actuellement en ligne

Statistiques des forums

Discussions
312 305
Messages
2 087 084
Membres
103 459
dernier inscrit
Arnocal