Regroupement de cellules portant les memes ref

BTPSHOP · Janvier 17, 2018, 2:20

Re bonjour, j aimerai regrouper dans mon tableau les mêmes références mais avec le résultat cumulé.

EX:
REF DESIGNATION QUANTITE PRIX UNITAIRE TOTAL

AA BATEAU 5 50 250
AA BATEAU 10 50 500

J aimerai que cela fasse après formule

AA BATEAU 15 50 750

mon fichier comporte 2000 ref je vous en joins un extrait.
MERCIexcel essai.xlsx (8,8 Ko)

mdo100 · Janvier 17, 2018, 5:26

Bonsoir @BTPSHOP,

Voici une proposition:

J’ai nommé les colonnes de la “Feuil1” dans le “Gestionnaire de noms”.

Puis j’ai mis les résultats dans la “Feuil2”

En “A2” une formule permettant d’extraire les réf de la “Feuil1” sans doublons.

=SI(LIGNE(A1)>SOMME(1/NB.SI(Col_A;Col_A));"";INDEX(Col_A;EQUIV(MIN(SI(NB.SI(A$1:A1;Col_A)=0;NB.SI(Col_A;"<"&Col_A)));NB.SI(Col_A;"<"&Col_A);0)))

Formule matricielle a valider avec les touches ctrl + maj + entrée
Tirer vers le bas autant que nécessaire.

En “B2”

=SIERREUR(INDEX(Col_B;EQUIV($A2;Col_A;0));"")
Tirer vers le bas autant que nécessaire.

En “C2”

SOMMEPROD((Col_A=$A2)*Col_C)

Tirer vers le bas autant que nécessaire.

En “D2”

=SIERREUR(INDEX(Col_D;EQUIV($A2;Col_A;0));"")
Tirer vers le bas autant que nécessaire.

En “E2”

=SOMMEPROD((Col_A=$A2)*Col_D)
Tirer vers le bas autant que nécessaire.

Ton fichier en retour ICI==>BTPSHOP V1.xlsx (15,7 Ko)

Cordialement.

Mimimathy · Janvier 17, 2018, 5:40

Bonjour à tous,
Salut MDO

t’as été plus rapide
un test en VBA
excel essai (1).xlsm (17,3 Ko)

Sub DoublonsTotal()
'Pour pouvoir utiliser cette méthode, assurez vous que la référence "Microsoft Scripting Runtime" est activée.

  Set d = CreateObject("Scripting.Dictionary") 'Création d'un Dico pour la colonne 2(Désignation)
  Set d2 = CreateObject("Scripting.Dictionary") 'Création d'un Dico pour la colonne 3 (Qté)
  Set d3 = CreateObject("Scripting.Dictionary") 'Création d'un Dico pour la colonne 4 (Prix Unit)
  Set d4 = CreateObject("Scripting.Dictionary") 'Création d'un Dico pour la colonne 5 (Total)
  For Each c In Range("a1", [a65000].End(xlUp))  'Boucle sur les données col 1
    d(c.Value) = d(c.Value) + c.Offset(, 1).Value ' regroupe dans le dico col 2
    d2(c.Value) = d2(c.Value) + c.Offset(, 2).Value ' regroupe dans le dico col 3
    d3(c.Value) = d3(c.Value) + c.Offset(, 3).Value ' regroupe dans le dico col 4
    d4(c.Value) = d4(c.Value) + c.Offset(, 4).Value ' regroupe dans le dico col 5
  Next c
  [A1:E65000].Clear 'vide la feuille
  [a1].Resize(d.Count, 1) = Application.Transpose(d.keys) 'replace les données col 1 sans doublons (clé)
  [b1].Resize(d.Count, 1) = Application.Transpose(d.items) 'replace les données col 2
  [c1].Resize(d.Count, 1) = Application.Transpose(d2.items) 'replace les données col 3
  [d1].Resize(d.Count, 1) = Application.Transpose(d3.items) 'replace les données col 4
  [e1].Resize(d.Count, 1) = Application.Transpose(d4.items) 'replace les données col 5
End Sub

mdo100 · Janvier 17, 2018, 7:47

Bonsoir @Mimimathy,

Mais ta solution est différente, donc @BTPSHOP a le choix.

Par contre et comme te l’a déjà demander @DocteurExcel, peux-tu expliciter tes réponses et mettre tes codes VBA et/ou tes formules dans le message.

Ce n’ai pas pour t’embêter, mais juste pour que ce soit plus clair pour celui / celle qui a ta réponse et surtout pour les nombreux visiteurs du forum qui peuvent y trouver une solution sans être obligés d’ouvrir un fichier.

Bien cordialement.

DocteurExcel · Janvier 18, 2018, 6:03

@Mimimathy Pour ajouter le code VBA il te suffit de le coller dans ton message, précédé de (3 accents graves vb) et suivi de (3 accents graves)
La syntaxe VBA est alors mise en valeur automatiquement! Comme expliqué ici Comment écrire du beau code VBA bien formatté sur ce forum

BTPSHOP · Janvier 18, 2018, 11:03

Waouuu merci, c’est quoi le VBA ? merci de m’aider j en suis très reconnaissant

BTPSHOP · Janvier 18, 2018, 11:05

Merci, je suis impressionné, je vais essayer de mettre cela en place.

UN GRAND GRAND MERCI

andy17 · Juillet 5, 2024, 11:11

bonjour, je suis nouveau et je ne sais pas vraiment comment fonctionne le forum.

j’ai trouvé ce VBS de Mimimaty que j’ai essayé d’adapter pour mes besoins mais a quelque part ça coince…

ci-joint mon fichier excel
colonne 1 = nb de pièces
colonne 2 = longueurs des pieces que je peux débiter sur une longueur de 4000mm
colonne 3 = reste ou chute
mon problème est que maintenan dans la colonne chute j’ai la totalité des chutes, et j’aurais besoin de la valeur pour une seule barre

mon VBA:

Sub DoublonsTotalmodif()
'Pour pouvoir utiliser cette méthode, assurez vous que la référence « Microsoft Scripting Runtime » est activée.

Set d = CreateObject(« Scripting.Dictionary ») 'Création d’un Dico pour la colonne 3(Zuschnitt)
Set d2 = CreateObject(« Scripting.Dictionary ») 'Création d’un Dico pour la colonne 1 (Anzahl)

For Each c In Range(« b1 », [b65000].End(xlUp)) 'Boucle sur les données col 2
d(c.Value) = d(c.Value) + c.Offset(, 1).Value ’ regroupe dans le dico col 3
d2(c.Value) = d2(c.Value) + c.Offset(, -1).Value ’ regroupe dans le dico col 1

Next c
[A1:E65000].Clear 'vide la feuille
[a1].Resize(d.Count, 1) = Application.Transpose(d2.items) 'replace les données col 1
[b1].Resize(d.Count, 1) = Application.Transpose(d.keys) 'replace les données col 2 sans doublons (clé)
[c1].Resize(d.Count, 1) = Application.Transpose(d.items) 'replace les données col 3

End Sub
essai regroupement longueurs.xls (32,5 Ko)

Cow18 · Juillet 5, 2024, 2:51

Sub Chutes()
     Dim i, N, Dict
     Set Dict = CreateObject("scripting.dictionary") 'dictionaire
     With Sheets("Tabelle")
          With .Range("A1").CurrentRegion 'vos données
               For i = 1 To .Rows.Count 'boucler
                    Dict(.Cells(i, "C").Value) = Dict(.Cells(i, "C").Value) + .Cells(i, "A").Value    'incrementer le nombre de ce chute avec la colonne A
              Next
          End With

          N = Dict.Count
          If N = 1 Then Dict([Rnd]) = 1 'seulement si le nombre de clés est 1, il faut ajouter un "dummy"

          With .Range("E2").Resize(N)
               .Resize(100, 2).ClearContents     'vider
               If N > 0 Then
                    .Value = Application.Transpose(Dict.keys)     'les chutes
                    .Offset(, 1).Value = Application.Transpose(Dict.items)     'son nombre
               End If
          End With
     End With
End Sub

essai regroupement longueurs.xls (73 Ko)

andy17 · Juillet 8, 2024, 6:03

bonjour Cow18
merci beaucoup pour votre aide, ça a l’air super, mais il me manque la colonne 2
Cordialement

Cow18 · Juillet 8, 2024, 7:13

n’est-ce pas possible en 32 tuyaux ???

essai regroupement longueurs.xls (81,5 Ko)

andy17 · Juillet 8, 2024, 7:33

non il en faut 41…
ça devrait ressembler à ça…

grafik

je crois que le problème est que le débitage devrait etre la clé, et non la chute

désolé suis limité à 3 réponses…

je comprends pas ou sont les 20%…

sachant que la liste des pieces fait 150 metres… je vois mal comment produire les pieces avec 32 barres à 4m
grafik

je ne connais pas le solveur…

si vous pouviez m’intégrer les 3 colonnes das le VBA? comme ci dessus?
NB Barre / Débitage / Chutes

désolé je suis un noob…

Cow18 · Juillet 8, 2024, 8:14

Si c’est obligatoire alors … mais c’est une réduction de 20% de la matière première !!!

Cow18 · Juillet 8, 2024, 11:06

Ich habe einen Fehler mit den Zahlen gemacht.
Finallement on a le même nombre, 41, mais moi, à partir de la 4eme combinaison, j’utilisais un autre système. (voir ligne 5, les cellules en rose).
Si on avait besoin de 44x610, moi, je pouvais le faire avec 40 barres.
(ma solution est réalisé avec « Solveur », un app d’Excel)

essai regroupement longueurs.xls (86,5 Ko)