Regrouper valeurs Array

Bonjour,

J'ai beaucoup de problème pour réaliser les étapes suivantes :

J'ai un array de type :

Avec ce tableau comme vous pouvez le voir, j'ai des nomenclatures similaires, je souhaite donc avoir :

Je précise que je ne connais ni l'emplacement à l'avance du doublons ni l'emplacement à l'avance du tableau.

j'ai :

Worksheets("User").Range(Cells(derniereL + 2, 3), Cells(derniereL + 10, 9)) = matmont

Merci pour votre aide!

Au cas ou vous voudriez le code qui créé le tableau, il doit être possible d'agir en amont :

Sub Materiel()
'********Matériel Canne*********************************
    Dim z As Byte
    Dim e As Byte
    Dim n As Byte
    Dim derniereL As Byte
    'Dim matmont() As Variant
    Dim matmont(10, 6)
    n = 0
        For z = 4 To 14 'jusqu'a la fin du tableau en colonne
            If Range("Choix_pos_regulateurs") = Sheets("Montage").Cells(1, z) Then Exit For
        Next z
        For e = 2 To 32
            If Sheets("Montage").Cells(e, z) >= 1 Then
            'ReDim Preserve matmont(n, 2)
            matmont(n, 0) = Sheets("Montage").Cells(e, 2)
            matmont(n, 5) = Sheets("Montage").Cells(e, 3)
            'définir les valeur de e en fonction de la colonne pour possible ajout user d'articles
            If e <= 13 Then matmont(n, 6) = Sheets("Montage").Cells(e, z) * PiqSt
            If PiqTour > 0 And e > 13 And e <= 23 Then matmont(n, 6) = Sheets("montage").Cells(e, z) * PiqTour
            If PiqRéh > O And e > 23 And e <= 25 Then matmont(n, 6) = Sheets("montage").Cells(e, z) * PiqRéh
            If PiqRampe > 0 And e > 25 And e <= 29 Then matmont(n, 6) = Sheets("montage").Cells(e, z) * PiqRampe
            If PiqKitroue > 0 And e > 29 And e <= 32 Then matmont(n, 6) = Sheets("montage").Cells(e, z) * PiqKitroue
            n = n + 1
            End If
        Next e
    'si matériels = 0 alors supprimer ligne
    Worksheets("User").Range(Cells(derniereL + 2, 3), Cells(derniereL + 10, 9)) = matmont

End Sub

Bonjour,

Un Dico te ferait ça en 5 lignes, mébon... Pas de fichier pour tester, pas le temps d'en construire un...

A+

Nooooon... J'avais pris l'habitude de mettre mon fichier à chaque fois mais depuis qu'il y a pas mal de module dedans les gens me répondent moins en me le renvoyant... Je te le joins au cas ou tu voudrais me partager ta solution, le module qui concerne cet array est dans M05_Matériel.

Bonsoir,

Bon déjà tu aurais intéret à charger ta sheet montage dans un array et à parcourir cet array, ce serait pas plus compliqué et un peu plus lisible...

Par dico il fallait comprendre "Dictionary" : L'idée au lieu de charger le matmont c'est de charger un dictionnary qui ne prend pas de doublon.

Bon je n'ai pas vraiment le temps de me brancher la dessus en cette veille de WE qui menace d'être interminable mais tu trouveras tout sur les dico ici :

http://boisgontierj.free.fr/pages_site/Dictionnaire.htm

Je t'accorde que pour une découverte tu n'ai pas tombé sur le plus simple mais une fois compris le principe, tu ne pourras plus t'en passer...

A+

Salut galopin01, BARNS

tu veux dire quoi par : "Je précise que je ne connais ni l'emplacement à l'avance du doublons ni l'emplacement à l'avance du tableau."

Bonjour AMIR,
C'est à dire que l'array généré est différent à chaque utilisation. Donc il faut réellement une solution qui interroge le fait ou pas qu'il y ai des valeur équivalente dans cet array et non une solution qui supprime des localisations dans une range. J'espère me faire comprend :s

Bonsoir Galopin,

J'ai commencé vba il y a 3 mois, j'ai ouvert ton fichier et j'ai eu mal à la tête au vu du nombre de pages, mais je vais m'y mettre directement puisque, c'est vrai il semble traiter des problématiques que je rencontre.

Je te remercie pour le partage.

Bonne semaine

Bonjour Galopin01,

J'ai suivi vos conseil au sujet des dictionnaires, mais je rencontre des difficultés à transposer mon array en dictionnaire pour ensuite pouvoir utiliser les fonction du dico.

Ici un exemple simplifié :

Sub CompteItems()
Dim tabtube(8, 0)
For i = 1 To 8
 tabtube(i - 1, 0) = Cells(i + 1, 1)
Next i
'Range("B2", "B10") = tabtube
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c LBound(tabtube, 2) To UBound(tabtube, 2)
    mondico(c.Value) = mondico(c.Value) + 1
  Next c
  [C2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
  [d2].Resize(mondico.Count, 1) = Application.Transpose(mondico.items)
  [C1].Sort Key1:=[C2], Order1:=xlAscending, Header:=xlYes
End Sub

Merci pour votre aide

Bonjour,

C'était pourtant pas difficile de joindre le bout de fichier que tu as mis en image au début...

Ecoute, si tu n'as pas le temps de fournir un fichier potable, moi j'ai pas de temps à perdre.

A+

Galopin 01,

Désolé je n'ai pas compris ce que tu souhaité exactement.

Il me semble avoir joint mon fichier au début de la conversation :

"confpartage-v20.xlsm (181.97 Ko)"

Mon nouveau fichier est le suivant (j'ai activé les parties de code qui sont concerné par le tri que je souhaite réaliser avec le dictionnaire) :

J'ai pensé que ça serait plus simple de le simplifier comme dans mon dernier message.

Je ne peux joindre mes parties de code puisqu'elles sont dépendantes les unes des autres. J'ai essayé de faire au plus simple avec le dernier fichier.

Si tu n'as pas le temps je te remercie tout de même pour la docs sur les dictionnaires.

Bonjour,

Voici un essai d'adaptation de votre code en chargeant le tableau sans boucle. La syntaxe du for each n'était pas bonne mais pour le reste ça me semblait correct :

Sub CompteItems()
Set mondico = CreateObject("Scripting.Dictionary")
with activesheet
    tabtube = .range("A2:A9").value
    For Each c in tabtube
        mondico(c) = mondico(c) + 1
    Next c
    .[C2].Resize(mondico.Count, 2) = Application.Transpose(array(mondico.keys, mondico.items))
    .[C1].Sort Key1:=.[C2], Order1:=xlAscending, Header:=xlYes
end with
End Sub

Cdlt,

Bonjour,

Merci pour votre réponse 3GB,

J'ai malheureusement un message d'erreur avec votre solution, je ne comprends pas (voir ci-après).

Oui, j'ai oublié de modifier ceci. c est un élément d'un tableau et non d'un objet. Par conséquent, c n'a pas de propriété...

Edit : Le code a été modifié

Cdlt,

Merci tout le monde pour votre aide!

La solution par 3GB partagé dans un autre post, ca pourrait en intéressé certains par la suite.

Sub CompteItems()
Set mondico = CreateObject("Scripting.Dictionary")
with activesheet
    tabtube = .range("A2:A9").value
    For Each c in tabtube
        mondico(c) = mondico(c) + 1
    Next c
    .[C2].Resize(mondico.Count, 2) = Application.Transpose(array(mondico.keys, mondico.items))
    .[C1].Sort Key1:=.[C2], Order1:=xlAscending, Header:=xlYes
end with
End Sub

Salut BARNS

Je me suis trompé le poste

https://forum.excel-pratique.com/s/goto/991758

J’ai modifié le classeur pour une meilleure performance ; Comme ça tu peux additionner les chiffres soit comme une somme ou comme une concaténation de textes.

Noter bien que chx_d ne doit pas égal a chx_add parce que c’est autre chose !