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

[Daniel38]

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.

 

[njhub]

Bonjour Daniel38,
testez la formule ci-dessous en M13

=SI($C14=$C13;"";SOMME.SI($C$5:$C13;$C13;$I$5:$I13))

 

[Daniel38]

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

 

[jm.andryszak]

Bonjour
Essayez la Sub Test()
J'ai ajouté le numéro de semaine en colonne B de façon à utiliser la formule
SOMME.SI.ENS(I:I;B:B;48) en colonne O

A adapter si ça répond à votre attente.

 

[Dranreb]

Bonjour.
Personnellement je l'aurais écrit comme ça :

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]

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").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]

Wow Dranreb
J'étais pas du tout équipé en neurones pour écrire ce sub sublime qui fonctionne à merveille.
J'ai pu l'intégrer à l'application juste en changeant Feuil1 par Activesheet

Bravo et encore merci

Sincères salutations

 

[Daniel38]

Bonjour jm.andryszak
Je regarde tout de suite

 

[Daniel38]

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.
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.

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

Merci beaucoup JM

 

[Daniel38]

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

 

[Dranreb]

Ajoutez ça avant le End If de ma procédure :

         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 :

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