Insérer une somme variable à chaque changement de jour pour calculer les heures totales par jour

Daniel38

XLDnaute Occasionnel
Bonjour, Bonsoir

Je cherche à insérer la formule somme( ) en fonction du nombre de services effectuées par jour pour calculer le total des heures par jour sachant que les heures de début et de fin (matin et après-midi sont toujours modifiées par rapport aux heures de services théoriques) Arffff ces transports, circulation, fous furieux sur la route, pannes et autres... ;)😊
Dans ce tableau de calcul des heures la formule somme s'écrit bien sur 1 seul jour en M13 et M14 (sexa et centième d'heure)
je souhaiterai effectuer cette insertion pour tout le mois mais ma boucle ne fonctionne pas ...
En gros je galère
Avez vous des idées ? ou autres solutions qu'une boucle.
😊 ;)
 

Pièces jointes

  • Insère sommes variables.xlsm
    45.2 KB · Affichages: 9
Solution
Ajoutez ça avant le End If de ma procédure :
VB:
         RLD = "R" & LDéb
         Cel.Offset(, -5).FormulaR1C1 = "=IF(RC[-1]=0,RC[-3],RC[-1])-IF(" _
            & RLD & "C[-4]=0," & RLD & "C[-2]," & RLD & "C[-4])"
Eh attention, dans votre classeur précédent il semble que la 1ère ligne de donnée était la 5. C'est passé à la 6 ???
Donc :
VB:
Sub CalculSommeHeuresParJour()
   Dim RngSpC As Range, Cel As Range, LDéb, RLD As String
   With ActiveSheet.[P6].Resize(ActiveSheet.[M1000000].End(xlUp).Row - 5)
      .FormulaR1C1 = "=1/(RC3<>R[1]C3)"
      Set RngSpC = .SpecialCells(xlCellTypeFormulas, 1).Offset(, -3)
      .Resize(, 2).ClearContents: End With
   LDéb = 6
   For Each Cel In RngSpC
      If Intersect(Columns(3), Cel.EntireRow).Value <>...

Daniel38

XLDnaute Occasionnel
Bonjour njhub
Merci pour ta réponse mais en fait la plage de la somme est variable sur les jours suivant sachant que cette somme doit être copiée à chaque dernière ligne du jour dans la colonne M.
Le nombre de ligne pour 1 jour peut-être différent.

Il s'agit donc de copier avec Vba la formule en colonne M sur la dernière ligne du jour pour calculer la somme des heures effectuées chaque jour

Pas facile :rolleyes:
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonjour.
Personnellement je l'aurais écrit comme ça :
VB:
Sub CalculSommeHeuresParJour()
   Dim RngSpC As Range, Cel As Range, LDéb
   With Feuil1.[M5].Resize(Feuil1.[M1000000].End(xlUp).Row - 4)
      .FormulaR1C1 = "=1/(RC3<>R[1]C3)"
      Set RngSpC = .SpecialCells(xlCellTypeFormulas, 1)
      .Resize(, 2).ClearContents: End With
   LDéb = 5
   For Each Cel In RngSpC
      If Intersect(Columns(3), Cel.EntireRow).Value <> "" Then
         With Cel
            .NumberFormat = "h:mm": .Font.Bold = True: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
            .FormulaR1C1 = "=SUM(R" & LDéb & "C[-4]:RC[-4])": End With
         With Cel.Offset(, 1)
            .NumberFormat = "0.00": .Font.Bold = True: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
            .FormulaR1C1 = "=RC[-1]*24": End With
         End If
      LDéb = Cel.Row + 1: Next Cel
   End Sub
 

jm.andryszak

XLDnaute Occasionnel
bonjour
Effectivement, le calcul se fait par jour, alors que je le fais par semaine (mauvaise lecture du post #3)
La macro corrigée est :
Nous obtenons les mêmes résultats.
PS : Sub Test paraît plus rapide.

Sub Test()
Dim i
Dim DerniereLigne
Dim Dic As Object
DerniereLigne = Range("b" & Rows.Count).End(xlUp).Row
Range("o:eek:").ClearContents
Set Dic = CreateObject("scripting.dictionary")
For i = 5 To DerniereLigne
'Dictionnaire jour (colonne c)
If Cells(i, 3) <> vbNullString Then Dic(CStr(Cells(i, 3))) = i
Next i
For i = LBound(Dic.items()) To UBound(Dic.items())
Range("o" & Dic.items()(i)).Formula = "=" & "SUMIFS(i:i,c:c," & CLng(Range("c" & Dic.items()(i))) & ")"
Next
End Sub
 

Daniel38

XLDnaute Occasionnel
Re bonjour jm.andryszak :)

Effectivement c'est beaucoup plus rapide mais je tiens à conserver la formule simple somme() que plutôt somme.si car mes collègues sont encore + quiche que moi et auront du mal à comprendre.
Ensuite la colonne services est réservée aux services et je ne comprends pas dans ton Sub où tu y fait références. :confused:
Il faut bien que la formule somme soit en fin de jour dans la colonne M et en colonne N la conversion en heures centième pour les comptables. :p

Donc j'ai du mal à adapter ton sub à l'application mais il fonctionne super bien et je le conserve précieusement. :p

Merci beaucoup JM :);)
 

Daniel38

XLDnaute Occasionnel
Bonsoir
Dranreb, jm.andryszak

Je me suis rendu compte que la procédure fige les formules et en efface certaines

Y'a t'il une solution pour éviter ceci car il faut que les sommes par jour et les calculs TTE et TTR reste dynamiques avec les formules car on modifie souvent les horaires ?

j'ai remplacé T = .Range("A1:K" & lg).Value par T = .Range("A1:H" & lg).Value
et ça marche

Mais d'autres formules sont supprimées (total des heures à 50% ) avec la procédure qui calcul les sommes par jour ?

La possibilité de mettre la formule somme() dans la dernière ligne du jour colonne 8 pour calculer cette amplitude serait top?
(attention il peut y avoir le matin seul travaillé ou l’après-midi ou la journée)

je ne comprends pas...


Daniel :rolleyes: :oops:
 

Pièces jointes

  • Calcul des amplitudes.xlsm
    86.5 KB · Affichages: 3

Dranreb

XLDnaute Barbatruc
Ajoutez ça avant le End If de ma procédure :
VB:
         RLD = "R" & LDéb
         Cel.Offset(, -5).FormulaR1C1 = "=IF(RC[-1]=0,RC[-3],RC[-1])-IF(" _
            & RLD & "C[-4]=0," & RLD & "C[-2]," & RLD & "C[-4])"
Eh attention, dans votre classeur précédent il semble que la 1ère ligne de donnée était la 5. C'est passé à la 6 ???
Donc :
VB:
Sub CalculSommeHeuresParJour()
   Dim RngSpC As Range, Cel As Range, LDéb, RLD As String
   With ActiveSheet.[P6].Resize(ActiveSheet.[M1000000].End(xlUp).Row - 5)
      .FormulaR1C1 = "=1/(RC3<>R[1]C3)"
      Set RngSpC = .SpecialCells(xlCellTypeFormulas, 1).Offset(, -3)
      .Resize(, 2).ClearContents: End With
   LDéb = 6
   For Each Cel In RngSpC
      If Intersect(Columns(3), Cel.EntireRow).Value <> "" Then
         RLD = "R" & LDéb
         With Cel
            .NumberFormat = "h:mm": .Font.Bold = True: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
            .FormulaR1C1 = "=SUM(" & RLD & "C[-4]:RC[-4])": End With
         With Cel.Offset(, 1)
            .NumberFormat = "0.00": .Font.Bold = True: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
            .FormulaR1C1 = "=RC[-1]*24": End With
         Cel.Offset(, -5).FormulaR1C1 = "=IF(RC[-1]=0,RC[-3],RC[-1])-IF(" _
            & RLD & "C[-4]=0," & RLD & "C[-2]," & RLD & "C[-4])"
         End If
      LDéb = Cel.Row + 1: Next Cel
   End Sub
 
Dernière édition:

Statistiques des forums

Discussions
312 867
Messages
2 093 034
Membres
105 616
dernier inscrit
Tigerwang