Microsoft 365 Somme suivant heures

nico3869 · 1 Mars 2024

Bonjour à tous,
Une fois encore je suis face un mur!
Je souhaiterai obtenir l'addition de 8 colonnes suivant des heures variables.
Plusieurs difficultés :
- Extraire les horaires si un même horaire identique dans les 8 colonnes
- Ensuite, avoir la somme des 8 valeurs à l'horaire identique...
J'espère que mes explications seront assez claires.
Merci d'avance pour votre aide

AtTheOne · 3 Mars 2024

Bonjour à toutes et à tous, bonjour @nico3869 ,
Comme tu es sur Excel365 , tu peux tenter ces deux formules :
La première pour la liste triée de tous les horaires (les données sont dans la plage nommée "tb") :

VB:

=TRIER(UNIQUE(TEMPSVAL(STXT(CONCAT(TEXTE(INDEX(tb;LIGNE(INDIRECT("1:"&LIGNES(tb)));TRANSPOSE(2*LIGNE(INDIRECT("1:"&COLONNES(tb)/2))-1));"hh:mm:ss"));SEQUENCE(504*8;1;1;8);8))))

(on passe par le format "hh:mm:ss" pour limiter le nombre de caractères car CONCAT est limitée à une chaîne de 32767 caractères, ici on passe juste 504*8*8=32256)

La deuxième pour faire la somme des valeurs associées à un horaires (ici l'horaire est en T9:

Code:

=LET(Lgn;LIGNE(INDIRECT("1:"&LIGNES(tb)));
         Col;TRANSPOSE(2*LIGNE(INDIRECT("1:"&COLONNES(tb)/2))-1);

          SOMME(SI(INDEX(tb;Lgn;Col)=T9;INDEX(tb;Lgn;Col+1);0)))

Chez moi quand on recopie cette formule pour les 648 horaires trouvés ça rame un peu !

EDIT : le text indent /indent dans la 2ème formule

Voir le fichier joint
A bientôt

AtTheOne · 3 Mars 2024

Re,
On peut aller jusqu'à 682 lignes de 8 horaires en modifiant la 2ème formule (heures au format hhmmss sans les 2 points dans la chaîne concaténée et en les rajoutant après) :

Code:

=TEMPSVAL(LET(lst;STXT(CONCAT(TEXTE(INDEX(tb;LIGNE(INDIRECT("1:"&LIGNES(tb)));TRANSPOSE(2*LIGNE(INDIRECT("1:"&COLONNES(tb)/2))-1));"hhmmss"));SEQUENCE(LIGNES(tb)*8;1;1;6);6);TRIER(UNIQUE((STXT(lst;1;2)&":"&STXT(lst;3;2)&":"&STXT(lst;5;2))))))

A bientôt

nico3869 · 10 Juillet 2024

Bonjour à tous,

Avec beaucoup de retard, merci pour vos réponses et votre intérêt sur mon problème.
Bonne continuation

AtTheOne · 10 Juillet 2024

Bonjour à toutes & à tous, bonjour @nico3869
Est-ce que l'on a répondu à ta question ?
Si c'est le cas, marque le post qui t'apporte la réponse comme solution.
À bientôt

nico3869 · 13 Mai 2025

AtTheOne à dit:
Re,
On peut aller jusqu'à 682 lignes de 8 horaires en modifiant la 2ème formule (heures au format hhmmss sans les 2 points dans la chaîne concaténée et en les rajoutant après) :

Code:

=TEMPSVAL(LET(lst;STXT(CONCAT(TEXTE(INDEX(tb;LIGNE(INDIRECT("1:"&LIGNES(tb)));TRANSPOSE(2*LIGNE(INDIRECT("1:"&COLONNES(tb)/2))-1));"hhmmss"));SEQUENCE(LIGNES(tb)*8;1;1;6);6);TRIER(UNIQUE((STXT(lst;1;2)&":"&STXT(lst;3;2)&":"&STXT(lst;5;2))))))

A bientôt

Bonjour Alain,
Tu réponds parfaitement à la demande.
Est il possible de compléter la formule pour permettre de s'adapter rapidement au nombre de ligne (si +/- de ligne de données suivant l'import).
Merci pour ton retour.

AtTheOne · 13 Mai 2025

Bonjour à toutes & à tous, bonjour @nico3869
J'ai transformé ta liste Horaires/Valeurs en Tableau Structuré ("TS_HV") et j'ai repris mes formules pour ne plus avoir la limitation liée à la fonction CONCAT ni par le nombre de colonnes de tes données (les formules fonctionnent pour un nombre de colonnes pair quelconque, si jamais tu avais des tableaux de plus de 16 colonnes).
Formule pour la liste des horaires sans doublon (avec LAMBDA récursive) dans la cellule nommée "ListeH" :

VB:

=LET(t;TS_HV;
     H;CHOISIRCOLS(t;SEQUENCE(1;ENT(COLONNES(t)/2);1;2));
     N;COLONNES(H);
     lbd;LAMBDA(me;i;tb;SI(i>N;tb;me(me;i+1;ASSEMB.V(tb;CHOISIRCOLS(H;i)))));
  TRIER(UNIQUE(lbd(lbd;2;CHOISIRCOLS(H;1)))))

Formule pour la somme des valeurs associées pour la liste précédente (ListeH# résultat de la formule précédente):

VB:

=BYROW(ListeH#;LAMBDA(H;SOMMEPROD(N(CHOISIRCOLS(TS_HV;SEQUENCE(1;COLONNES(TS_HV)/2;1;2))=H);
                                    CHOISIRCOLS(TS_HV;SEQUENCE(1;COLONNES(TS_HV)/2;2;2)))
  ))

Formule pour la somme des valeurs associées à l'horaire choisi (cellule nommée "Horaire_choisi")

VB:

=SOMMEPROD(N(CHOISIRCOLS(TS_HV;SEQUENCE(1;COLONNES(TS_HV)/2;1;2))=Horaire_choisi);
             CHOISIRCOLS(TS_HV;SEQUENCE(1;COLONNES(TS_HV)/2;2;2)))

Formule pour renvoyer la liste des valeurs associées à l'horaire choisi :

VB:

=LET(t;TS_HV;
     H;CHOISIRCOLS(t;SEQUENCE(1;ENT(COLONNES(t)/2);1;2));
     V;CHOISIRCOLS(t;SEQUENCE(1;ENT(COLONNES(t)/2);2;2));
     N;COLONNES(H);
     lbdA;LAMBDA(me;i;tb;SI(i>N;tb;me(me;i+1;ASSEMB.V(tb;CHOISIRCOLS(H;i)))));
     LH;lbdA(lbdA;2;CHOISIRCOLS(H;1));
     lbdB;LAMBDA(me;i;tb;SI(i>N;tb;me(me;i+1;ASSEMB.V(tb;CHOISIRCOLS(V;i)))));
     LV;lbdB(lbdB;2;CHOISIRCOLS(V;1));
FILTRE(LV;LH=Horaire_choisi))

nico3869 à dit:
Est il possible de compléter la formule pour permettre de s'adapter rapidement au nombre de ligne (si +/- de ligne de données suivant l'import)

Oui, maintenant il suffit de vider le TS "TS_HV" et d'y coller tes nouvelles données
On peut faire une macro pour importer tes nouvelles données, envoie un fichier brut (sans aucune modification) de ces données (ça peut être un fichier txt ...) Je te ferai une macro d'import.

À bientôt

Voir le fichier joint

job75 · 13 Mai 2025

Bonjour à tous,

Non non non VBA n'est pas mort car il bououge...

La macro évènementielle dans la feuille "Résultats" :

VB:

Private Sub Worksheet_Activate()
Dim t, plage As Range, tablo, ub%, i&, j%, d As Object, dd As Object, v#, jj%, n&
t = Timer
Set plage = Feuil1.Range("C8:R" & Feuil1.Range("C" & Rows.Count).End(xlUp).Row)
tablo = plage.Value2
ub = UBound(tablo, 2)
'---épuration---
For i = 2 To UBound(tablo)
    For j = 1 To ub Step 2
        tablo(i, j) = CDbl(Left(tablo(i, j), 9)) 'on garde 7 décimales
Next j, i
plage = tablo
'---résultats---
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    For j = 1 To ub Step 2
        v = tablo(i, j)
        If d.exists(v) Then If d(v) Then GoTo 2 Else GoTo 1 'gagne du temps
        For jj = 1 To ub Step 2
            If jj <> j Then If IsError(Application.Match(v, plage.Columns(jj), 0)) Then d(v) = False: GoTo 1
        Next jj
        d(v) = True
2       dd(v) = dd(v) + tablo(i, j + 1) 'somme
1 Next j, i
'---restitution---
With [A2]
    n = dd.Count
    If n Then
        .Resize(n) = Application.Transpose(dd.keys) 'Transpose est limitée à 65536 lignes
        .Offset(, 1).Resize(n) = Application.Transpose(dd.items)
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
    .Cells(0).Resize(n + 1, 2).Sort .Cells, xlAscending, Header:=xlYes 'tri croissant
End With
With UsedRange: End With 'actualise la barre de défilement verticale
Application.ScreenUpdating = True
If n Then MsgBox n & " lignes obtenues en " & Format(Timer - t, "0.00 \sec")
End Sub

Elle s'exécute chez moi en 0,09 seconde.

Seule limite : le tableau des résultats ne doit pas dépasser 65536 lignes.

A+

AtTheOne · 13 Mai 2025

Re,
@nico3869 si tu pouvais répondre dans un délai raisonnable, ce serait bien 😉
Ma proposition précédente : te faire une macro d'import tient toujours bien-sûr

Tant qu'à faire du VBA voici une version à l'opposé de la précédente qui était "tout par formules" cette fois c'est tout par VBA !

La lecture du Tableau Structuré :

VB:

Sub LireTS()
     Dim DC As New Scripting.Dictionary
   
     'Horaire sélectionné avant la modification
     H = Sh_Rapport.[Horaire_Choisi].Value
     'Contenu du TS "TS_HV"
     Ts = Sh_Rapport.[TS_HV]
   
     'le TS est supposé avoir un nombre de colonnes pair
     If UBound(Ts, 2) Mod 2 = 1 Then
          MsgBox "Nombre de colonnes impair !"
          Exit Sub
     End If
   
     Application.ScreenUpdating = False
   
     'Dictionnaire des horaires (Clef = Horaire, Article =Cumul des valeurs associes à cet horaire)
     For i = 1 To UBound(Ts, 1)
          For j = 1 To UBound(Ts, 2) - 1 Step 2
               DC(Ts(i, j)) = DC(Ts(i, j)) + Ts(i, j + 1)
          Next
     Next
   
     'Redéfinir le nom de la zone cible en fonction du nombre de clefs trouvées
     ThisWorkbook.Names.Add Name:="ListeH", RefersTo:=Sh_Rapport.[ListeH].Resize(DC.Count, 2)
   
     Application.EnableEvents = False
     'Renseigner la zone cible
     Sh_Rapport.[ListeH].Columns(1).Formula = WorksheetFunction.Transpose(DC.Keys)
     Sh_Rapport.[ListeH].Columns(2).Formula = WorksheetFunction.Transpose(DC.Items)
   
     'Trier la zone cible
     With Sh_Rapport.Sort
          .SortFields.Clear
          .SortFields.Add2 Key:=Sh_Rapport.[ListeH].Resize(, 1)
          .SetRange Sh_Rapport.[ListeH]
          .Header = xlNo
          .Apply
     End With
   
     'Effacer les cellules liées à l'horaire choisi
     With Sh_Rapport.[Horaire_Choisi]
          .Resize(1, 2).ClearContents
           Range(.Offset(0, 2), .Offset(0, 2).End(xlDown)).ClearContents
     End With
     'Si l'horaire choisi précédent fait toujours partie de la liste le remettre
     '(On réactive les événement pour provoquer le WorkSheet_Change)
     Application.EnableEvents = True
     If DC.Exists(H) Then
          Sh_Rapport.[Horaire_Choisi].Value = H
     End If
   
     Application.ScreenUpdating = True
End Sub

Les événements gérés de la feuille "Rapport" (CodeName "Sh_Rapport")

VB:

Private Sub Worksheet_Activate()
     LireTS
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
   
     ModeEv = Application.EnableEvents
     Application.EnableEvents = False
     Dim TbV()

'Modifications dans le tableau structuré ou dans la liste des horaires avec valeurs associées
     If Not Intersect(Target, Me.[TS_HV]) Is Nothing Or _
        Not Intersect(Target, Me.[ListeH]) Is Nothing Then
          LireTS
     End If
   
'Modification de l'Horaire choisi
     nb = 0
     With Me.[Horaire_Choisi]
          H = .Value
          If Target.Address = .Address Then
               Application.ScreenUpdating = False
               .Offset(0, 1) = WorksheetFunction.VLookup(H, Me.[ListeH], 2, False)
               Tb = Me.[TS_HV]
               For i = 1 To UBound(Tb, 1)
                    For j = 1 To UBound(Tb, 2) - 1 Step 2
                         If Tb(i, j) = H Then
                              nb = nb + 1: ReDim Preserve TbV(1 To nb): TbV(nb) = Tb(i, j + 1)
                         End If
                    Next
               Next
               Range(.Offset(0, 2), .Offset(0, 2).End(xlDown)).ClearContents
               .Offset(0, 2).Resize(nb).Value = WorksheetFunction.Transpose(TbV)
               Application.ScreenUpdating = True
         End If
     End With
   
     Application.EnableEvents = ModeEv
   
End Sub

AtTheOne · 13 Mai 2025

Bonjour @job75
Juste un petit retard avant le rafraîchissement !
Effectivement VBA dans ce cas est moins pénalisant que les formules qui revisitent le TS à chaque recalcul !
À +

AtTheOne · 13 Mai 2025

Re
@job75, cette fois c'est ta macro qui a des pertes en lignes 😉!
J'ai 648 heures différentes sur les 4032 heures que comprend le tableau, tu n'en ramènes que 268 ...
Par exemple 08:36:30 , 08:27:58 etc sont passées à la trappe !

À bientôt
Amicalement

job75 · 14 Mai 2025

Bonjour AtTheOne, le forum,

AtTheOne à dit:
J'ai 648 heures différentes sur les 4032 heures que comprend le tableau, tu n'en ramènes que 268 ...
Par exemple 08:36:30 , 08:27:58 etc sont passées à la trappe !

Comme Cousinhub je ne comptabilise les heures que quand elles existent dans les 8 colonnes.

A+

AtTheOne · 14 Mai 2025

Bonjour @job75

nico3869 à dit:
Plusieurs difficultés :
- Extraire les horaires si un même horaire identique dans les 8 colonnes

Oups ! pas vu cette contrainte, mille excuse maître 😌!
En attendant @nico3869 n'a toujours pas réagi 😒

À bientôt

EDIT :
Ce qui m'étonne c'est que @nico3869 ait validé le post #17 qui ne tient pas compte de cette contrainte 🤨

job75 · 14 Mai 2025

A la réflexion tronquer les décimales des heures ne me paraît pas excellent, je préfère ceci :

VB:

'---épuration---
For i = 2 To UBound(tablo)
    For j = 1 To ub Step 2
        tablo(i, j) = TimeValue(Format(tablo(i, j), "h:mm:ss")) 'pas de fractions de seconde
Next j, i
plage = tablo

ALS35 · 14 Mai 2025

Bonjour à tous,
Au cas où, avec M365, une formule unique et dynamique :

VB:

=LET(s;SUPPR.PLAGE(BDD!C9:R10000);t;ORGA.LIGNES(DANSCOL(s);2);n;NB.SI(s;INDEX(ORGA.LIGNES(DANSCOL(s);2);;1));r;ASSEMB.H(t;n);f;FILTRE(r;INDEX(r;;3)>=8);g;GROUPER.PAR(INDEX(f;;1);INDEX(f;;2);SOMME;0;0);g)

Cordialement

AtTheOne · 14 Mai 2025

Re,

ALS35 à dit:
Au cas où, avec M365, une formule unique et dynamique :

Malheureusement je n'ai que EXCEL2024, il me manque des fonctions pour tester . 😢
En attendant j'ai revu ma copie pour tenir compte de la remarque de @job75 :

job75 à dit:
Comme Cousinhub je ne comptabilise les heures que quand elles existent dans les 8 colonnes.

Le nouveau code :

VB:

Sub LireTS_B()
     
     'Avec horaire apparaissant dans toutes les colonnes d'heures
     Dim DC As New Scripting.Dictionary
     Dim DC8 As New Scripting.Dictionary
     
     'Horaire sélectionné avant la modification
     H = Sh_Rapport.[Horaire_Choisi].Value
     'Contenu du TS "TS_HV"
     Ts = Sh_Rapport.[TS_HV]
     
     'le TS est supposé avoir un nombre de colonnes pair
     If UBound(Ts, 2) Mod 2 = 1 Then
          MsgBox "Nombre de colonnes impair !"
          Exit Sub
     End If
     
     Application.ScreenUpdating = False
     
     'Dictionnaire des horaires (Clef = Horaire, Article =Cumul des valeurs associes à cet horaire)
     'Liste des horaire de la 1ère colonne
     For i = 1 To UBound(Ts, 1)
          DC(Ts(i, 1)) = DC(Ts(1, 1)) + Ts(i, 2)
          DC8(Ts(i, 1)) = 1
     Next
     'Colonnes suivantes
     For j = 3 To UBound(Ts, 2) - 1 Step 2
          For i = 1 To UBound(Ts, 1)
               If DC8.Exists(Ts(i, j)) Then
                    DC(Ts(i, j)) = DC(Ts(i, j)) + Ts(i, j + 1)
                    'Si DC8 déjà compté dans les colonnes précédentes on incrémente de 1
                    If DC8(Ts(i, j)) = j - j \ 2 - 1 Then DC8(Ts(i, j)) = DC8(Ts(i, j)) + 1
               End If
          Next
     Next
     'Retire les clef de DC si DC8 ne vaut pas le nombre de colonnes d'horaires
     Nbcol = UBound(Ts, 2) / 2
     For Each clef In DC8.Keys
          If DC8(clef) <> Nbcol Then DC.Remove clef
     Next
     
     'Redéfinir le nom de la zone cible en fonction du nombre de clefs trouvées
     Sh_Rapport.[ListeH].ClearContents
     Sh_Rapport.[ListeH].ClearContents
     ThisWorkbook.Names.Add Name:="ListeH", RefersTo:=Sh_Rapport.[ListeH].Resize(DC.Count, 2)
     
     Application.EnableEvents = False
     'Renseigner la zone cible
     With Sh_Rapport.[ListeH]
          If .Rows.Count > 1 Or .Cells(1) <> "" Then
               .Columns(1).Formula = WorksheetFunction.Transpose(DC.Keys)
               .Columns(2).Formula = WorksheetFunction.Transpose(DC.Items)
          End If
     End With
     'Trier la zone cible
     With Sh_Rapport.Sort
          .SortFields.Clear
          .SortFields.Add2 Key:=Sh_Rapport.[ListeH].Resize(, 1)
          .SetRange Sh_Rapport.[ListeH]
          .Header = xlNo
          .Apply
     End With
     
     'Effacer les cellules liées à l'horaire choisi
     With Sh_Rapport.[Horaire_Choisi]
          .Resize(1, 2).ClearContents
           Range(.Offset(0, 2), .Offset(0, 2).End(xlDown)).ClearContents
     End With
     'Si l'horaire choisi précédent fait toujours partie de la liste le remettre
     '(On réactive les événement pour provoquer le WorkSheet_Change)
     Application.EnableEvents = True
     If DC.Exists(H) Then
          Sh_Rapport.[Horaire_Choisi].Value = H
     End If
     Application.ScreenUpdating = True
End Sub

Et je tombe bien sur les mêmes valeurs (268 horaires différents au lieu de mes 648), mais j'ai laissé le premier code au cas où ...

Les événements gérés de la feuille "Rapport" (CodeName "Sh_Rapport") :

VB:

Private Sub Worksheet_Activate()
     Application.ScreenUpdating = False
'     LireTS         'Toutes les heures différentes quelque soit le nbre de colonnes où elles apparaissent
     LireTS_B        'Heures apparaissant dans toutes les colonnes d'heures
     Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
     Application.ScreenUpdating = False
     ModeEv = Application.EnableEvents
     Application.EnableEvents = False
     Dim TbV()

'Modifications dans le tableau structuré ou dans la liste des horaires avec valeurs associées
     If Not Intersect(Target, Me.[TS_HV].EntireColumn) Is Nothing Or _
        Not Intersect(Target, Me.[ListeH]) Is Nothing Then
'          LireTS         'Toutes les heures différentes quelque soit le nbre de colonnes où elles apparaissent
          LireTS_B        'Heures apparaissant dans toutes les colonnes d'heures
     End If
     
'Modification de l'Horaire choisi
     nb = 0
     With Me.[Horaire_Choisi]
          H = .Value
          If H = "" Then
              .Offset(0, 1).ClearContents
              Range(.Offset(0, 2), .Offset(0, 2).End(xlDown)).ClearContents
              
          Else
               If Target.Address = .Address Then
                    Application.ScreenUpdating = False
                    On Error Resume Next
                    .Offset(0, 1) = WorksheetFunction.VLookup(H, Me.[ListeH], 2, False)
                    On Error GoTo 0
                    Tb = Me.[TS_HV]
                    For i = 1 To UBound(Tb, 1)
                         For j = 1 To UBound(Tb, 2) - 1 Step 2
                              If Tb(i, j) = H Then
                                   nb = nb + 1: ReDim Preserve TbV(1 To nb): TbV(nb) = Tb(i, j + 1)
                              End If
                         Next
                    Next
                    Range(.Offset(0, 2), .Offset(0, 2).End(xlDown)).ClearContents
                    If nb > 0 Then .Offset(0, 2).Resize(nb).Value = WorksheetFunction.Transpose(TbV)
                    Application.ScreenUpdating = True
               End If
          End If
     End With
     
     Application.EnableEvents = ModeEv
     Application.ScreenUpdating = True
End Sub

À bientôt

Microsoft 365 Somme suivant heures

XLDnaute Nouveau

Pièces jointes

XLDnaute Accro

Pièces jointes

XLDnaute Accro

XLDnaute Nouveau

XLDnaute Accro

XLDnaute Nouveau

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Accro

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

Pièces jointes

XLDnaute Accro

Pièces jointes

Discussions similaires

Nous accordons de l'importance à votre vie privée