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

job75 · 14 Mai 2025

Avec cette méthode je ne corrige plus le tableau source et les heures sont converties en textes :

VB:

Private Sub Worksheet_Activate()
Dim t, tablo, ub1&, ub2%, i&, j%, d As Object, dd As Object, x$, jj%, ii&, n&
t = Timer
tablo = Feuil1.Range("C8:R" & Feuil1.Range("C" & Rows.Count).End(xlUp).Row)
ub1 = UBound(tablo)
ub2 = UBound(tablo, 2)
'---heures au format texte---
For i = 2 To ub1
    For j = 1 To ub2 Step 2
        tablo(i, j) = Format(tablo(i, j), "h:mm:ss") 'élimine les fractions de seconde
Next j, i
'---résultats---
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
For i = 2 To ub1
    For j = 1 To ub2 Step 2
        x = tablo(i, j)
        If d.exists(x) Then If d(x) Then GoTo 2 Else GoTo 1 'gagne du temps
        For jj = 1 To ub2 Step 2
            If jj <> j Then
                For ii = 1 To ub1
                    If tablo(ii, jj) = x Then Exit For
                Next ii
                If ii > ub1 Then d(x) = False: GoTo 1
            End If
        Next jj
        d(x) = True
2       dd(x) = dd(x) + 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

La durée d'exécution reste à peu près la même.

AtTheOne · 14 Mai 2025

Re,

job75 à dit:
je ne corrige plus le tableau source et les heures sont converties en textes

Il ne me semble pas qu'il y ait des variation dans les fraction de seconde, car je prend la valeur directement (double) comme clef et je trouve le même nombre de lignes que toi ...
Mais c'est peut-être une précaution utile, je ne sais pas.
Je crois que là on s'amuse car @nico3869 ne répond plus, c'est pas grave on progresse !
À bientôt

nico3869 · 14 Mai 2025

AtTheOne à dit:

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

Bonsoir Alain et à la communauté,
Ta formule répond parfaitement à la demande, je t'en remercie. Concernant la macro, pas besoin de t'embêter avec ça....
Un grand merci à tous pour votre aide, vous êtes géniaux!!!!

job75 · 14 Mai 2025

AtTheOne à dit:
Il ne me semble pas qu'il y ait des variation dans les fraction de seconde,

Il y a 1354 fractions de secondes parasites mais elles portent sur les 17èmes décimales des heures.

AtTheOne · 14 Mai 2025

re

job75 à dit:
Il y a 1354 fractions de secondes parasites mais elles portent sur les 17èmes décimales des heures.

Bon, mais ce que je ne comprends pas c'est que sans faire de conversion, en gardant la valeur double, quand je liste toutes les heures du tableau sans doublon, je ne vois pas apparaître ces valeurs parasites.
Si je mets le résultat au format hh:mm:ss je ne vois pas de valeurs identiques répétées or d'après ton relevé je devrais avoir un paquet d'heures en double (même seconde avec une variation d'un pouillème non visible vu le format utilisé).
Non, je ne comprends pas.

Merci @nico3869 pour ton retour

À bientôt, je vais me couché et demain c'est repos !

job75 · 15 Mai 2025

Bonjour AtTheOne, le forum,

AtTheOne à dit:
Bon, mais ce que je ne comprends pas c'est que sans faire de conversion, en gardant la valeur double, quand je liste toutes les heures du tableau sans doublon, je ne vois pas apparaître ces valeurs parasites.

Moi aussi j'ai eu du mal à comprendre.

Tout simplement sur le fichier du post #1, pour une même heure, les 8 valeurs parasites sont les mêmes :

VB:

Sub Test1()
Dim v#, c As Range
v = CDbl(TimeValue("08:36:36"))
For Each c In [C15,E47,G13,I16,K24,M12,O16,Q13]
    MsgBox Format(CDbl(c) - v, "0.00000.E-00"), , c.Address(0, 0)
Next
End Sub

Sub Test2()
Dim v#, c As Range
v = CDbl(TimeValue("08:36:37"))
For Each c In [C16,E48,G14,I17,K25,M13,O17,Q14]
    MsgBox Format(CDbl(c) - v, "0.00000.E-00"), , c.Address(0, 0)
Next
End Sub

A+

AtTheOne · 15 Mai 2025

Bonjour à toutes & à tous , bonjour @job75 ,
Merci pour ta réponse.

job75 à dit:
Tout simplement sur le fichier du post #1, pour une même heure, les 8 valeurs parasites sont les mêmes :

Ce qui explique que mon dictionnaire basé sur les valeurs numériques fonctionne correctement !
Je suis sur mon téléphone, je regarderai demain de plus près...
À bientôt

job75 · 15 Mai 2025

AtTheOne à dit:
Ce qui explique que mon dictionnaire basé sur les valeurs numériques fonctionne correctement !

Oui mais bien comprendre que si l'on maintient les fractions de seconde parasites il peut y avoir des problèmes.

Voyez le fichier joint : le résultat de 08:36:36 disparaît quant on revalide la cellule C15 du tableau source.

AtTheOne · 15 Mai 2025

Re,

job75 à dit:
le résultat de 08:36:36 disparaît quant on revalide la cellule C15 du tableau source.

Bien vu ! En effet c'est une fragilité de la méthode, je n'y avait pas pensé.
(Toujours sur mon téléphone, je ferai le test plus tard)
Autre détail, j'ai hérité le tutoiement de l'entreprise qui m' employait, ne t'en offusque pas ce n'est pas un manque de respect. 🫡
À bientôt

job75 · 15 Mai 2025

AtTheOne à dit:
En effet c'est une fragilité de la méthode

Il n'y a pas de fragilité si on élimine les fractions de seconde parasites avec le code "épuration" des posts #22 ou #28.

AtTheOne · 15 Mai 2025

job75 à dit:
Il n'y a pas de fragilité si on élimine les fractions de seconde parasites

Re, oui c'est bien ce que j'ai compris 🫡

nico3869 · 17 Mai 2025

Bonsoir à vous,
Merci pour votre intérêt sur mon problème.
Je vous confirme qu'il apparait quelques erreurs sur la formule proposées par AtTheOne,
Bonne continuation à vous.

AtTheOne · 17 Mai 2025

Bonsoir à toutes & à tous, Bonsoir @nico3869,

nico3869 à dit:
Je vous confirme qu'il apparait quelques erreurs sur la formule proposées par AtTheOne,

Est-ce sur la version avec formule ? (post #21) , elle ne tiens pas compte de la contrainte de l'apparition dans les 8 colonnes ni du problème des fractions de seconde,
ou celle avec VBA (post #30) avec les erreurs potentielles su les fractions de seconde ?
Je vais corriger cette dernière version pour tenir compte de la très bonne remarque de @job75, et je vais la poster plus tard dans la soirée (voire la nuit)
À bientôt

AtTheOne · 17 Mai 2025

Re,
Voici la version avec VBA corrigée pour s'affranchir du problème des fractions de seconde
Je regarde si j'arrive à faire le traitement dans la version par formule (apparition dans les 8 colonnes + fractions de seconde) ...
À bientôt

AtTheOne · 19 Mai 2025

Bonjour à toutes & à tous, bonjour @nico3869 ,

Comme promis au post précédent, j'ai cherché une solution par formule intégrant la contrainte de l'apparition dans les 8 colonnes et s'affranchissant des horaires avec fractions de seconde.

Eh bin ! Ce que j'ai pondu n'est pas brillant ! Ça prend 12 secondes à chaque re calcul, autant dire que ce n'est pas une solution ...
Mais, bon je l'ai fait alors je le poste. Voilà les formules :

Liste de horaires convenant (triés sans doublon) :

VB:

=LET(t;TS_HV;
     H;TEMPSVAL(TEXTE(CHOISIRCOLS(t;SEQUENCE(1;ENT(COLONNES(t)/2);1;2));"hh:mm:ss"));
     N;COLONNES(H);
     L;LIGNES(H);
     Lbd;LAMBDA(me;i;T;SI(i>L;T;me(me;i+1;ASSEMB.V(T;SOMME(BYCOL(H;LAMBDA(LL;N(ESTNUM(EQUIV(INDEX(H;i;1);LL;0))))))))));
     test;FILTRE(Lbd(Lbd;1;"");Lbd(Lbd;1;"")<>"");
TRIER(UNIQUE(FILTRE(INDEX(H;;1);test=N))))

Somme des nombres associés à ces horaires

Code:

=BYROW(ListeH#;LAMBDA(H;SOMMEPROD(N(TEMPSVAL(TEXTE(CHOISIRCOLS(TS_HV;SEQUENCE(1;ENT(COLONNES(TS_HV)/2);1;2));"hh:mm:ss"))=H);
                                  CHOISIRCOLS(TS_HV;SEQUENCE(1;COLONNES(TS_HV)/2;2;2)))))

Somme des nombres associé à l'horaire choisi :

Code:

=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)))

Liste des nombres associés à l'horaire choisi :

Code:

=LET(t;TS_HV;
     H;TEMPSVAL(TEXTE(CHOISIRCOLS(t;SEQUENCE(1;ENT(COLONNES(t)/2);1;2));"hh:mm:ss"));
     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))

Si quelqu'un à une solution efficasse par formule (avec les mêmes contraintes) , je suis preneur (j'ai EXCEL2024)

À bientôt

Microsoft 365 Somme suivant heures

nico3869

XLDnaute Nouveau

Pièces jointes

AtTheOne

job75

XLDnaute Barbatruc

Pièces jointes

AtTheOne

XLDnaute Accro

nico3869

XLDnaute Nouveau

job75

XLDnaute Barbatruc

AtTheOne

XLDnaute Accro

job75

XLDnaute Barbatruc

AtTheOne

XLDnaute Accro

job75

XLDnaute Barbatruc

Pièces jointes

AtTheOne

XLDnaute Accro

job75

XLDnaute Barbatruc

AtTheOne

XLDnaute Accro

nico3869

XLDnaute Nouveau

AtTheOne

XLDnaute Accro

AtTheOne

XLDnaute Accro

Pièces jointes

AtTheOne

XLDnaute Accro

Pièces jointes

Discussions similaires

Microsoft 365 Somme suivant heures

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Nouveau

XLDnaute Accro

XLDnaute Accro

Pièces jointes

XLDnaute Accro

Pièces jointes

Discussions similaires

Privacy & Transparency

Privacy & Transparency