XL 2013 Regroupement de données selon plusieurs critères..

anri0610

XLDnaute Junior
Bonjour a tous,

Mon soucis:
effectuer la somme des valeurs de la colonne E si/quand les valeurs des colonnes A B C D sont toutes identiques,
j'aurais pourtant essayer d être clair... ><

je vous joint le fichier concerne, sachant que les valeurs diffèrent toutes a chaque travail donc impossible de définir une règle pour une quelconque valeur.

ex/
maintenant:

AW-1 110 25 2100 10
AW-1 110 25 2100 10
AW-1 110 25 2100 10
AW-1 110 25 2100 10
AW-1 110 25 2100 10
AW-3 110 25 800 10

résultat souhaite:

AW-1 110 25 2100 50
AW-3 110 25 800 10

je souhaiterai effectuer ce résultat avec une macro,
et ne pas transformer la mise en forme des données pour un tableau dynamique.
est-ce seulement possible ?
 

Pièces jointes

  • TEST.xlsx
    10 KB · Affichages: 50

Victor21

XLDnaute Barbatruc
Bonjour.
upload_2018-8-6_11-1-14.png
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

Code:
Sub Regroupe()
  Set d = CreateObject("Scripting.Dictionary")
  Tbl = Range("A2:E" & [A65000].End(xlUp).Row).Value
  For i = LBound(Tbl) To UBound(Tbl)
    clé = Tbl(i, 1) & "-" & Tbl(i, 2) & "-" & Tbl(i, 3) & "-" & Tbl(i, 4)
    d(clé) = d(clé) + Tbl(i, 5)
  Next i
  [h2].Resize(d.Count) = Application.Transpose(d.keys)
  [i2].Resize(d.Count) = Application.Transpose(d.items)
End Sub

jb
 

Pièces jointes

  • Copie de Transposetableau.xls
    52 KB · Affichages: 33
  • Sans titre.png
    Sans titre.png
    12.4 KB · Affichages: 28
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour à tous,

Le VBA est inutile avec cette formule en F2 à tirer vers le bas :
Code:
=SI(A2&B2&C2&D2<>A1&B1&C1&D1;SOMMEPROD(N(A$1:A$1000&B$1:B$1000&C$1:C$1000&D$1:D$1000=A2&B2&C2&D2);E$1:E$1000);"")
Augmenter la ligne 1000 si nécessaire.

Fichier joint.

A+
 

Pièces jointes

  • TEST(1).xlsx
    16.1 KB · Affichages: 26

job75

XLDnaute Barbatruc
Re,

Et sur Excel 2007 et versions suivantes on peut utiliser SOMME.SI.ENS :
Code:
=SI(A2&B2&C2&D2<>A1&B1&C1&D1;SOMME.SI.ENS(E:E;A:A;A2;B:B;B2;C:C;C2;D:D;D2);"")
Fichier (2).

A+
 

Pièces jointes

  • TEST(2).xlsx
    16.1 KB · Affichages: 28

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Dernière édition:

job75

XLDnaute Barbatruc
Re,

Avec VBA on peut créer ou supprimer les sous-totaux :
Code:
Sub CréerSupprimerSousTotal()
Application.ScreenUpdating = False
With Feuil1 'CodeName de la feuille
    .Rows.Hidden = False 'affihe tout
    .Columns(6).ClearContents 'RAZ
    With .[A1].CurrentRegion
        If .Rows.Count = 1 Then Exit Sub
        With .Offset(1).Resize(.Rows.Count - 1).Columns(6)
            If .Parent.DrawingObjects(1).Text Like "Créer*" Then
                .Cells(0, 1) = "S/TOTAL" 'titre
                .Formula = "=IF(A2&B2&C2&D2<>A1&B1&C1&D1,SUMIFS(E:E,A:A,A2,B:B,B2,C:C,C2,D:D,D2),"""")"
                .Value = .Value 'supprime les formules
                On Error Resume Next 'si aucune SpecialCell
                .SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 'masque les lignes des cellules vides
            End If
        End With
    End With
    .DrawingObjects(1).Text = IIf(.DrawingObjects(1).Text Like "Créer*", "Supprimer", "Créer") & " S/TOTAL"
End With
End Sub
Fichier joint.

Important : avec SOMME.SI.ENS la durée d'exécution varie comme le carré du nombre de lignes, chez moi sur Win 10 - Excel 2013 :

- 5 200 lignes => 1,4 seconde

- 52 000 lignes => 142 secondes.

A+
 

Pièces jointes

  • TEST VBA(1).xlsm
    25.3 KB · Affichages: 38

zebanx

XLDnaute Accro
Bonjour @job75
Ca fait longtemps -)
Je vois que tu es toujours intéressé par la vitesse de croisière du code.
Très bonne journée et bonnes vacances à toi (et à tous les fondus de codes si utiles ici qui se reconnaitront) si elles arrivent -)
 
Dernière édition:

anri0610

XLDnaute Junior
Bonjour,

Réponse tardive=décalage horaire +horaires de travail, je me faisait une impatience de vous répondre,

Tout d'abord merci infiniment pour toutes vos solutions,
j'ai tout essayer et je n'ai malheureusement pas atteint le résultat souhaite pour la suite ,
je m'explique et vous joint les fichiers ,

Je me doit de garder la structure de base car pour la suite une macro me renvoie toutes ces données a cote en vertical que j'utilise pour les transposer
dans un éditeur de texte qui se nomme apsaly et qui édite a la verticale (éditeur relie a un programme CAD que je ne peux changer dans ce cas la),
pardon cette fois ci je vous fournis le test avec la macro que j'utilise pour la suite, je l'ai definie sur Ctrl+a.

Victor21> La structure change complètement et je suis embêter par la suite.

Dranreb>j'obtient une erreur et ne sais pas comment procéder.

Lone-wolf>je n'obtient pas de sommes.

Boisgontier>Cela me change complètement la structure et me pose problème pour la suite.

Job75>Le résultat est presque parfait j'ai cru un instant que la solution était enfin trouvée , malheureusement pour la suite les données qui ont
disparues sont retranscrites , je souhaiterai aussi avoir les somme et donc résultats a la place des données de la colonne E si possible,
sinon recréer la même structure car a part les en tètes qui peuvent changer j'ai besoin de la structure pour la suite, vous comprendrez mieux avec
le fichier je pense.
je vous ai joint le fichier neutre et votre fichier avec la macro appliquée.
ps: le bouton bleu ne fonctionne pas, cela me dit que la macro n'est pas disponible dans le classeur et je n'en aurais pas l’utilité pour la suite
mais merci bien !! : )

encore un grand merci !,
j'attends avec impatience vos réponses !
 

Pièces jointes

  • TEST suite avec macro Ctrl+a.xlsm
    19.3 KB · Affichages: 21
  • erreur gigogne.png
    erreur gigogne.png
    181.6 KB · Affichages: 22
  • lone-wolf resultat.png
    lone-wolf resultat.png
    74.3 KB · Affichages: 22
  • probleme resultat victor 21.png
    probleme resultat victor 21.png
    85.6 KB · Affichages: 21
  • resultat job75.xlsm
    21 KB · Affichages: 22

Dranreb

XLDnaute Barbatruc
Dranreb>j'obtient une erreur et ne sais pas comment procéder.
Quelle erreur obtenez vous ? Plantage ? Sur quelle instruction ?
Seriez vous su MAC ?

Chez moi aucun plantage.
La Sub Regrouper, corrigée pour qu'elle fournisse directement le résultat sous la forme obtenue par votre macro :
VB:
Sub Regrouper()
   Dim TR(), LR&, Arg1 As SsGr, Arg2 As SsGr, Arg3 As SsGr, Arg4 As SsGr
'   ReDim TR(1 To Feuil1.UsedRange.Rows.Count, 1 To 5)
   ReDim TR(1 To Feuil1.UsedRange.Rows.Count * 5, 1 To 1)
   For Each Arg1 In Gigogne(Feuil1.[A2:E2], 1, 2, 3, 4)
      For Each Arg2 In Arg1.Co
         For Each Arg3 In Arg2.Co
            For Each Arg4 In Arg3.Co
'               LR = LR + 1
'               TR(LR, 1) = Arg1.Id
'               TR(LR, 2) = Arg2.Id
'               TR(LR, 3) = Arg3.Id
'               TR(LR, 4) = Arg4.Id
'               TR(LR, 5) = Arg4.Somme(5)
               LR = LR + 1: TR(LR, 1) = Arg1.Id
               LR = LR + 1: TR(LR, 1) = Arg2.Id
               LR = LR + 1: TR(LR, 1) = Arg3.Id
               LR = LR + 1: TR(LR, 1) = Arg4.Id
               LR = LR + 1: TR(LR, 1) = Arg4.Somme(5)
               Next Arg4, Arg3, Arg2, Arg1
'      Feuil1.[A2].Resize(UBound(TR, 1), 5).Value = TR
      Feuil1.[G2].Resize(UBound(TR, 1)).Value = TR
   End Sub
upload_2018-8-7_9-5-3.png
 
Dernière édition:

Discussions similaires

Réponses
36
Affichages
1 K

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG