Calcul horaire [RESOLU]

P

pascal82

XLDnaute Occasionnel
Bonjour à toutes et tous,

Besoin d'un coup de main pour calculer les horaires en fonction d'une règle imposée. Je bidouille avec des "si" et cela devient incompréhensible pour obtenir le résultat souhaité.

Un grand merci par avance aux forumeurs
 

Pièces jointes

  • Calcul heures.xls
    26 KB · Affichages: 32
  • Calcul heures.xls
    26 KB · Affichages: 31
  • Calcul heures.xls
    26 KB · Affichages: 33
Dernière édition:
Trier par date Trier par votes
P

pascal82

XLDnaute Occasionnel
Re : Calcul horaire

Bonjour vgendron, le forum,

Désolé pour le manque d'information.
Je dois calculer le nombre d'heures passées (écart entre début et fin du tableau A4:G17) en fonction d'une règle imposée (tableau T2:AR10)
Prenons des exemples pour être plus clair:
lundi 01-12-14, premier segment 17:00 à 19:00, donc selon la règle, 2h de A
lundi 01-12-14, deuxième segment 20:00 à 23:00, donc selon la règle 3h00 de B
Résultat pour la date du 01-12-14 , en I4 2:00 de A et 03:00 de B en J4
autre exemple:
Mardi 02-12-14, premier segment 18:00 à 22:00, donc selon la règle, 2h de A pour 18:00 a 20:00 et 2h00 de B pour aller de 20:00 à 22:00
Suite à votre intervention je viens de me rendre compte d'une grossière erreur dans la légende des couleurs, je modifie donc le fichier d'origine
Pour les formules, il n'y en pas parce que je n'y arrive pas, le tableau I2:L17 est le résultat souhaité
En espérant avoir répondu à votre attente et dans l'attente de vous lire.

Cordialement
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re : Calcul horaire

Hello

un vrai casse tete ton truc ;-)

j'avais pas envie de me lancer dans une macro.. donc..
regarde un peu la proposition ci jointe..

ce n'est qu'un début, puisque les heures de C et D ne sont pas comptées. normalement. ce devrait etre la meme chose que pour A et B en cas de dimanche
.....
 

Pièces jointes

  • Calcul heures (1).xls
    76.5 KB · Affichages: 26
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Calcul horaire

Bonjour pascal82, vgendron,

Oui c'est compliqué, même en utilisant VBA.

Voyez le fichier joint et cette macro :

Code: 
Sub Comptage()
Dim dat As Range, deb1&, fin1&, deb2&, fin2&, deb3&, fin3&
Dim jour As Byte, r As Range, h1&, h2&, heure#, coul&, col%
Set dat = Range("A4", Range("A" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
[I4:L4].Resize(Rows.Count - 3).ClearContents 'RAZ
For Each dat In dat
  If IsDate(dat) Then
    deb1 = Round(dat(1, 2) * 1440): fin1 = Round(dat(1, 3) * 1440)
    deb2 = Round(dat(1, 4) * 1440): fin2 = Round(dat(1, 5) * 1440)
    deb3 = Round(dat(1, 6) * 1440): fin3 = Round(dat(1, 7) * 1440)
    jour = Weekday(dat, 2)
    If Application.CountIf([Fériés], dat) Then jour = 7
    Set r = [U3:AR3].Offset(jour)
    For Each r In r
      h1 = Round(Cells(2, r.Column) * 1440)
      h2 = Round(Cells(3, r.Column) * 1440)
      heure = (IIf(h1 > fin1 Or h2 < deb1, 0, _
        IIf(h2 <= fin1, h2, fin1) - IIf(h1 >= deb1, h1, deb1)) _
        + IIf(h1 > fin2 Or h2 < deb2, 0, _
        IIf(h2 <= fin2, h2, fin2) - IIf(h1 >= deb2, h1, deb2)) _
        + IIf(h1 > fin3 Or h2 < deb3, 0, _
        IIf(h2 <= fin3, h2, fin3) - IIf(h1 >= deb3, h1, deb3))) / 1440
      coul = r.Interior.Color
      For col = 9 To 12 'colonnes I à L
        If Cells(2, col).Interior.Color = coul Then _
          dat(1, col) = dat(1, col) + heure: Exit For
      Next
    Next
  End If
Next
End Sub
Nota : il est difficile de comparer des heures, il faut les transformer en minutes pour comparer des nombres entiers.

Edit : j'avais laissé des résultats de tests dans le tableau des règles, je les efface.

A+
 

Pièces jointes

  • Calcul heures(1).xls
    62.5 KB · Affichages: 23
Dernière édition:
Vote positif 0 Vote négatif
P

pascal82

XLDnaute Occasionnel
Re : Calcul horaire

Bonsoir vgendron, le forum

Un grand merci pour votre contribution.
Je viens de regarder votre fichier avec beaucoup d'intérêt, cependant nous avons des résultats différents, certain de ma faute et d'autre sur votre fichier et je suis incapable de modifier quoi que ce soit.
Bilan:
la journée du 05-12 je trouve bien A=2:00 et B=0:30
la journée du 06-12 je trouve bien A=6:00 et B=3:30
la journée du 08-12 je me suis trompé, vous avez raison A=2:00 et B=1:00
la journée du 11-12 je trouve bien A=3:00 et B=2:00
la journée du 12-12 je me suis trompé, vous avez raison A=0:00 et B=2:00
la journée du 13-12 je trouve bien A=2:00 et B=8:30
Par contre de mon coté j'ai fractionnée les formules pour gagner en visibilité. Les résultats me conviennent et il me reste la gestion des jours fériés.
Je joins en annexe mon fichier

Cordialement
 

Pièces jointes

  • Calcul heures.xls
    133 KB · Affichages: 28
  • Calcul heures.xls
    133 KB · Affichages: 27
  • Calcul heures.xls
    133 KB · Affichages: 24
Vote positif 0 Vote négatif
P

pascal82

XLDnaute Occasionnel
Re : Calcul horaire

Bonsoir job75,

Comme d'habitude je suis impressionné par votre contribution, Vous avez raison je me suis trompé dans mes résultats au post #1. Je tente de comprendre votre code et poserais des questions si besoin.
Encore un grand merci à vgendron et à job75

Cordialement
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Calcul horaire

Re,

pascal82 à dit:
Je tente de comprendre votre code et poserais des questions si besoin.
Cliquez pour agrandir...

A votre service, n'hésitez pas.

Voici une solution un peu plus "propre" en nommant "Règle" la plage des règles :

Code: 
Sub Comptage()
Dim regle As Range, fer As Range, dat As Range
Dim deb1&, fin1&, deb2&, fin2&, deb3&, fin3&, jour As Byte
Dim col%, h1&, h2&, heure#, coul&, colonne%
Set regle = [Règle]: Set fer = [Fériés]
Application.ScreenUpdating = False
[I4:L4].Resize(Rows.Count - 3).ClearContents 'RAZ
For Each dat In Range("A4", Range("A" & Rows.Count).End(xlUp))
  If IsDate(dat) Then
    deb1 = Round(dat(1, 2) * 1440): fin1 = Round(dat(1, 3) * 1440)
    deb2 = Round(dat(1, 4) * 1440): fin2 = Round(dat(1, 5) * 1440)
    deb3 = Round(dat(1, 6) * 1440): fin3 = Round(dat(1, 7) * 1440)
    jour = Weekday(dat, 2)
    If Application.CountIf(fer, dat) Then jour = 7
    For col = 1 To regle.Columns.Count
      h1 = Round(regle(1, col) * 1440) 'début
      h2 = Round(regle(2, col) * 1440) 'fin
      heure = (IIf(h1 > fin1 Or h2 < deb1, 0, _
        IIf(h2 <= fin1, h2, fin1) - IIf(h1 >= deb1, h1, deb1)) _
        + IIf(h1 > fin2 Or h2 < deb2, 0, _
        IIf(h2 <= fin2, h2, fin2) - IIf(h1 >= deb2, h1, deb2)) _
        + IIf(h1 > fin3 Or h2 < deb3, 0, _
        IIf(h2 <= fin3, h2, fin3) - IIf(h1 >= deb3, h1, deb3))) / 1440
      coul = regle(jour + 2, col).Interior.Color
      For colonne = 9 To 12 'colonnes I à L, couleurs en ligne 2
        If Cells(2, colonne).Interior.Color = coul Then _
          dat(1, colonne) = dat(1, colonne) + heure: Exit For
      Next
    Next
  End If
Next
End Sub
Fichier (2).

Bonne fin de soirée et A+
 

Pièces jointes

  • Calcul heures(2).xls
    62 KB · Affichages: 27
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Calcul horaire [RESOLU]

Bonjour pascal82, vgendron, le forum,

S'il y a beaucoup de dates ce sera plus rapide avec des tableaux VBA :

Code: 
Sub Comptage()
Dim regle As Range, fer As Range, couleur As Range
Dim reg, ncol%, coul, dat, rest(), i&, j%
Dim deb1&, fin1&, deb2&, fin2&, deb3&, fin3&, jour As Byte
Dim h1&, h2&, heure&, col As Variant
'---initialisation des tableaux---
Set regle = [Règle]: Set fer = [Fériés]: Set couleur = [I2:L2]
reg = regle: ncol = UBound(reg, 2)
coul = couleur
dat = Range("A4:G" & Range("A" & Rows.Count).End(xlUp).Row)
ReDim rest(1 To UBound(dat), 1 To UBound(coul, 2))
'---codes des couleurs---
For i = 3 To UBound(reg)
  For j = 1 To ncol
    reg(i, j) = regle(i, j).Interior.Color
  Next
Next
For j = 1 To UBound(coul, 2)
  coul(1, j) = couleur(1, j).Interior.Color
Next
'---heures en minutes---
For j = 1 To ncol
  reg(1, j) = Round(reg(1, j) * 1440) 'début
  reg(2, j) = Round(reg(2, j) * 1440) 'fin
Next
'---dates et heures---
For i = 1 To UBound(dat)
  If IsDate(dat(i, 1)) Then
    deb1 = Round(dat(i, 2) * 1440): fin1 = Round(dat(i, 3) * 1440)
    deb2 = Round(dat(i, 4) * 1440): fin2 = Round(dat(i, 5) * 1440)
    deb3 = Round(dat(i, 6) * 1440): fin3 = Round(dat(i, 7) * 1440)
    jour = Weekday(dat(i, 1), 2)
    If Application.CountIf(fer, dat(i, 1)) Then jour = 7
    For j = 1 To ncol
      h1 = reg(1, j): h2 = reg(2, j)
      heure = IIf(h1 > fin1 Or h2 < deb1, 0, _
        IIf(h2 <= fin1, h2, fin1) - IIf(h1 >= deb1, h1, deb1)) _
        + IIf(h1 > fin2 Or h2 < deb2, 0, _
        IIf(h2 <= fin2, h2, fin2) - IIf(h1 >= deb2, h1, deb2)) _
        + IIf(h1 > fin3 Or h2 < deb3, 0, _
        IIf(h2 <= fin3, h2, fin3) - IIf(h1 >= deb3, h1, deb3))
      col = Application.Match(reg(jour + 2, j), coul, 0)
      If IsNumeric(col) Then rest(i, col) = rest(i, col) + heure / 1440
    Next
  End If
Next
'---restitution---
With couleur.Offset(2).Resize(UBound(rest))
  .Value = rest
  .Offset(UBound(rest)).Resize(Rows.Count - UBound(rest) - .Row + 1) = ""
End With
End Sub
Fichier (3).

Je pense qu'on a maintenant fait le tour de la question.

Bonne journée et A+
 

Pièces jointes

  • Calcul heures(3).xls
    66.5 KB · Affichages: 26
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Calcul horaire [RESOLU]

Re,

Une dernière chose, j'ai testé sur Win XP - Excel 2003 les durées d'exécution :

- fichier (2) => 40,5 millisecondes

- fichier (3) => 9,8 millisecondes, donc 4 fois plus rapide sur un tableau de 14 dates.

Edit : sur un tableau de 1400 dates c'est 6 fois plus rapide.

A+
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Calcul horaire [RESOLU]

Bonjour Pascal, le forum,

C'est du pinaillage mais cette macro fait encore gagner 18% sur le temps de calcul :

Code: 
Sub Comptage()
Dim regle As Range, fer As Range, couleur As Range
Dim reg, ncol%, coul, dat, rest(), i&, j%
Dim deb1&, fin1&, deb2&, fin2&, deb3&, fin3&, jour As Byte
Dim col As Variant, h1&, h2&, heure&
'---initialisation des tableaux---
Set regle = [Règle]: Set fer = [Fériés]: Set couleur = [I2:L2]
reg = regle: ncol = UBound(reg, 2)
coul = couleur
dat = Range("A4:G" & Range("A" & Rows.Count).End(xlUp).Row)
ReDim rest(1 To UBound(dat), 1 To UBound(coul, 2))
'---codes des couleurs---
For i = 3 To UBound(reg)
  For j = 1 To ncol
    reg(i, j) = regle(i, j).Interior.Color
  Next
Next
For j = 1 To UBound(coul, 2)
  coul(1, j) = couleur(1, j).Interior.Color
Next
'---heures en minutes---
For j = 1 To ncol
  reg(1, j) = Round(reg(1, j) * 1440) 'début
  reg(2, j) = Round(reg(2, j) * 1440) 'fin
Next
'---dates et heures---
For i = 1 To UBound(dat)
  If IsDate(dat(i, 1)) Then
    deb1 = Round(dat(i, 2) * 1440): fin1 = Round(dat(i, 3) * 1440)
    deb2 = Round(dat(i, 4) * 1440): fin2 = Round(dat(i, 5) * 1440)
    deb3 = Round(dat(i, 6) * 1440): fin3 = Round(dat(i, 7) * 1440)
    jour = Weekday(dat(i, 1), 2)
    If Application.CountIf(fer, dat(i, 1)) Then jour = 7
    For j = 1 To ncol
      col = Application.Match(reg(jour + 2, j), coul, 0)
      If IsNumeric(col) Then
        h1 = reg(1, j): h2 = reg(2, j)
        If h1 >= fin1 Or h2 <= deb1 Then heure = 0 Else _
          heure = IIf(h2 < fin1, h2, fin1) - IIf(h1 > deb1, h1, deb1)
        If h1 < fin2 And h2 > deb2 Then _
          heure = heure + IIf(h2 < fin2, h2, fin2) - IIf(h1 > deb2, h1, deb2)
        If h1 < fin3 And h2 > deb3 Then _
          heure = heure + IIf(h2 < fin3, h2, fin3) - IIf(h1 > deb3, h1, deb3)
        rest(i, col) = rest(i, col) + heure / 1440
      End If
    Next
  End If
Next
'---restitution---
With couleur.Offset(2).Resize(UBound(rest))
  .Value = rest
  .Offset(UBound(rest)).Resize(Rows.Count - UBound(rest) - .Row + 1) = ""
End With
End Sub
En effet dans la macro du fichier (3) tous les tests des IIf sont évalués, même quand c'est inutile.

Fichier (4).

A+
 

Pièces jointes

  • Calcul heures(4).xls
    66.5 KB · Affichages: 29
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

T
  • Question
XL 2016 Calculer ratio de 0 à 1 par mois (janvier, fév, mars.. à partir date d'entrée et d'arrivée
Réponses
4
Affichages
268
Lolote83
L
B
  • Résolu(e)
XL 2016 Retirer une tranche horaire pour calcul de temps
Réponses
9
Affichages
431
Phil69970
Phil69970
P
  • Résolu(e)
Microsoft 365 recherche heure dans une plage horaire
Réponses
12
Affichages
305
TooFatBoy
TooFatBoy
J
  • Question
Base de données avec userform d'enregistrement et état imprimable en pdf
Réponses
2
Affichages
313
juniorekondo.36
J
D
  • Question
Microsoft 365 Différence entre deux dates
Réponses
10
Affichages
165
Daniel200666
D
nauwel
  • Question
XL 2021 Besoin d'un coup de main
Réponses
3
Affichages
182
nauwel
nauwel
lemanois
  • Question
Microsoft 365 Date échéance avec jours ouvrés
Réponses
5
Affichages
170
lemanois
lemanois
P
  • Résolu(e)
XL 2019 Application d'un pourcentage avec une macro
Réponses
8
Affichages
236
pat66
P
D
  • Résolu(e)
Microsoft 365 fonction de recherche multiple
Réponses
3
Affichages
238
dd_76
D
K
  • Question
XL 2019 VBA colorer les cellules et éliminer les cellules en rouge dans le calcul de plus proche valeur
Réponses
3
Affichages
242
KAMARY
K

Membres actuellement en ligne

17 membres et 162 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 304
Messages
2 087 067
Membres
103 452
dernier inscrit
SOOSOKA