Macro regroupement de valeur d'un champ

Bonjour à tous,

Je suis confronté à un problème que je n'arrive pas à résoudre en vba excel. Vous pouvez surement m'aider

Ci-joint, petit exemple illustratif.

Ce que je pensais faire :

Pour chaque valeur distinct de mon champ NUMERO, je dois stocker dans x variables, toutes les valeurs distinctes de COULEUR. Que je concatenerais après...

Mais je suis incapable de faire ça

Quelqu'un à déjà fait un truc similaire ?

Merci d'avance pour votre aide

Bonjour,

tiens un peu de code à adapter :

'
' Rajouter la référence à Microsoft runtime
'
'
Sub MonTest()
 Dim tb()
 Dim c As New Dictionary

 tb = Feuil1.Range("A1").CurrentRegion
 Dim i As Integer

 'On rempli le dictionnaire..
 For i = 2 To UBound(tb, 1)
    If Not c.Exists(tb(i, 1)) Then
        c.Add tb(i, 1), tb(i, 2)
            Else
        c(tb(i, 1)) = c(tb(i, 1)) & " / " & tb(i, 2)
    End If
Next

 '---- AFFICHAGE DU DICTIONNAIRE DANS FENETRE EXECUTION
 For Each s In c.keys

    Debug.Print s & " | " & c(s)

 Next

End Sub

Bonsoir Pierre,

Merci pour ce petit bout de code. J'ai testé ça semble fonctionnelle, même avec plus de 4 couleurs différentes. Seule la gestion des valeurs uniques n'est pas gérée mais c'est pas bien grave.

Par contre, je ne comprends pas très bien le code peux-tu m'expliquer un peu

On alimente un tableau.

Si mon numero n'existe pas alors on ajoute dans mon tableau le NUMERO (colonne 1) et la COULEUR (colonne 2 )

Si mon numero existe déjà...

Qu

For i = 2 To UBound(tb, 1)
    If Not c.Exists(tb(i, 1)) Then
        c.Add tb(i, 1), tb(i, 2)
            Else
        c(tb(i, 1)) = c(tb(i, 1)) & " / " & tb(i, 2)
    End If
Next

For Each s In c.keys

Qu'est ce que c'est que ce keys?

Peux-tu m'expliquer un peu ce code?

Je t'en remercie d'avance,

Bonjour ,

Pour compléter tes commentaires :

schibidi a écrit :

Bonsoir Pierre,

Merci pour ce petit bout de code. J'ai testé ça semble fonctionnelle, même avec plus de 4 couleurs différentes. Seule la gestion des valeurs uniques n'est pas gérée mais c'est pas bien grave.

Je ne comprends pas ce que tu veux faire de plus pour les valeurs unique ?

schibidi a écrit :

Par contre, je ne comprends pas très bien le code peux-tu m'expliquer un peu

On alimente un tableau.

en fait c'est pas un tableau c'est un dictionnaire , caractérisé par une clé (Key) par éléments.

schibidi a écrit :

Si mon numero n'existe pas alors on ajoute dans mon tableau le NUMERO (colonne 1) et la COULEUR (colonne 2 )

Si mon numero existe déjà...

Qu

On utilise la valeur dans ta colonne numéro comme clef ..(key) , si celle-ci n'existe pas on ajout un élément dans le dictionnaire avec numéro comme clef et couleur comme item (donnée)..

si le numéro existe ( clef déjà utilisée) on modifie l'item associé en y concaténant "/" + nouvelle couleur...

schibidi a écrit :

For i = 2 To UBound(tb, 1)
    If Not c.Exists(tb(i, 1)) Then
        c.Add tb(i, 1), tb(i, 2)
            Else
        c(tb(i, 1)) = c(tb(i, 1)) & " / " & tb(i, 2)
    End If
Next

For Each s In c.keys

Qu'est ce que c'est que ce keys?

Keys et la "collection" de clef contenu dans dictionnaire dans ton cas tes numéros.. on parcours donc la liste des numéros pour afficher ensuite la clef (le numéro) et la colonne (item) associée..

Bonjour Pierre,

Entre temps j'avais regardé sur internet le fonctionnement de DICTIONNARY Librairie pour obtenir des précisions. C'est pas mal du tout.

Merci pour tes explications en tous cas !

Concernant mes valeurs uniques, je voulais par exemple qu'on évite d'avoir

1 jaune/jaune/vert mais 1 jaune/vert.

Il faudrait rajouter une condition du style (ci-dessous) mais il faut au préalable trier la table :

For i = 2 To UBound(tb, 1)
    If Not c.Exists(tb(i, 1)) Then
        c.Add tb(i, 1), tb(i, 2)
             ElseIf c(tb(i, 1)) = tb(i, 2) Then
                    c(tb(i, 1)) = c(tb(i, 1))
              Else
              c(tb(i, 1)) = c(tb(i, 1)) & " / " & tb(i, 2)
             End If

Next

Ou bien filtrer en amont sur les valeurs en double.

Je clôture le sujet. Merci ton aide rapide et précieuse.

A bientôt et bon dimanche

Bonjour,

Lors du rajout d'une couleur tu peu bien vérifier qu'elle n'est pas dėjà la avec instr...

Ah oui effectivement je vais essayer de rajouter un test avec instr.

Merci