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 ?
 

Fichiers joints

Victor21

XLDnaute Barbatruc
Supporter XLD
Bonjour, Lone-wolf.

Pourquoi :
wb.Range("m2").FormulaLocal = "=SOMME.SI.ENS($F$2:$F$27;$A$2:$A$27;H2)"
alors que :
Set plage = wb.Range("a2:f" & wb.Range("f" & Rows.Count).End(xlUp).Row)
 

BOISGONTIER

XLDnaute Barbatruc
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
 

Fichiers joints

Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re Patrick
Bonjour Jacques :)

@Victor21 : vu que le tableau des résultats est plus petit, je ne savais pas comment faire les sommes, c'est pour cela que j'ai mis la formule. Par VBA ça affichait des zéro.
 

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+
 

Fichiers joints

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+
 

Fichiers joints

BOISGONTIER

XLDnaute Barbatruc
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+
 

Fichiers joints

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 !
 

Fichiers joints

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:

anri0610

XLDnaute Junior
Bonjour,

merci Dranreb !

vraiment désoler , je viens a nouveau d'essayer en copiant le code mais même en essayant de trouver le problème j'ai toujours une erreur,
pourriez vous m'envoyer le fichier avec la macro configurée s'il vous plait?

ps: Le resultat est super !!! Serait il possible de garder l'ordre décroissant au moment de la mise en forme sur la droite?
pour avoir toujours les valeur les plus élevées dans l'ordre ?
je ne sais pas si je suis clair :s

ça donnerait ,

AW-1
110
25
2100
50

AW-3
110
25
800
10

AW-1
108
25
1750
50

Etc.
La valeur la plus importante(ordre de logique décroissante) est la colonne B, ensuite dans l'ordre C, D, E, et enfin A.

L'ordre de la forme actuelle est bon mais je souhaitais additionner les quantités pour ensuite le basculer dans le même ordre
sous la forme de droite !

Je file, je consulte les message demain a la première heure .(heure d'ici)!merci!
 

Dranreb

XLDnaute Barbatruc
Vous ne me dites toujours pas de quelle erreur il s'agit.
Vous avez copié le code dans un autre projet VBA ? Y avez vous alors aussi bien glissé le module MGigogne et le module de classe SsGr ? Par ailleurs une fonction du module MGigogne a besoin de la référence Microsoft Scripting Runtime.
La macro rectifiée avec les ordre de classement demandés (sauf E qui est une somme calculée))
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour anri0610, le fil,
je souhaiterai aussi avoir les somme et donc résultats a la place des données de la colonne E si possible,
Il suffit alors de masquer la colonne E :
Code:
Sub CréerSupprimerSousTotal()
Application.ScreenUpdating = False
With Feuil1 'CodeName de la feuille
    .Rows.Hidden = False: .Columns.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
                .Columns(0).Hidden = True 'masque la colonne E
            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 (2).

A+
 

Fichiers joints

anri0610

XLDnaute Junior
Bonjour !

pardon je vous joint le print screen,
je suis sur windows 7, excel 2013,
j'obtient une erreur de compilation, désoler je ne saurai quoi modifier..

job75> merci super mais pour la suite j'obtient ce resultat.
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
Bonsoir.
Moi non plus je ne sais pas quoi modifier, parce que chez moi il n'y a aucune erreur dans cette instruction Dim.
Et en mettant la déclaration de Préfiltré avant celle de Tronquer, ça fait pareil ? Non mais ça n'a pas de sens. Je n'ai pas la moindre idée du problème qu'il peut y avoir. Peut être des caractères non visibles à la place des espaces, je ne sais pas du tout.
Vous pouvez toujours essayer de le joindre tel qu'il est chez vous, que je voie s'il a été altéré d'une quelconque façon, de telle sorte qu'il y aurait aussi une erreur chez moi, maintenant.
Édition: je viens quand même de voir un truc: c'est le 1er nom de variable comportant des lettres accentuées. Alors est-ce que par hasard sur votre système elle ne seraient pas considérées comme des lettres ???
 
Dernière édition:

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas