liste de valeur différente

[maxis6582]

Bonsoir,
j'aurais besoin d'aide pour réaliser un travail sur des listes. Je ne parviens pas a trouver les terme de recherche me permettant de trouver les réponses sur le forum.

J'ai un tableau (avec 50 000 lignes) avec 3 colonnes contenant des valeurs identiques, je doit pour traiter et extraire les données de manière à supprimer les doublons de la colonne A, mais indiquer dans B et C les différentes valeurs correspondante séparées par un pipe.

Plus clair avec le fichier en PJ avec la feuille 1 contenant les données source et le résultat attendu en feuille 2

Je vous remercie par avance pour votre aide.

 

[BOISGONTIER]

Re : liste de valeur différente

Bonsoir,

cf Objet dictionary

Sub Regroupe()
  Set d = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
      If Not d.exists(c.Value) Then
         d(c.Value) = c.Offset(0, 1)
         d2(c.Value) = c.Offset(0, 2)
      Else
        d(c.Value) = d(c.Value) & "|" & c.Offset(0, 1)
        d2(c.Value) = d2(c.Value) & "|" & c.Offset(0, 2)
      End If
  Next c
  [f2].Resize(d.Count) = Application.Transpose(d.keys)
  [g2].Resize(d.Count) = Application.Transpose(d.items)
  [h2].Resize(d.Count) = Application.Transpose(d2.items)
End Sub

jb

 

[maxis6582]

Re : liste de valeur différente

réponse rapide et efficace, tout simplement merci!!! ça va me faire gagner un temps fou. Je garde bien au chaud ce code aussi pour une prochaine...

Merci encore et bonne soirée

 

[maxis6582]

Re : liste de valeur différente

Bonsoir,

cf Objet dictionary

Sub Regroupe()
  Set d = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
      If Not d.exists(c.Value) Then
         d(c.Value) = c.Offset(0, 1)
         d2(c.Value) = c.Offset(0, 2)
      Else
        d(c.Value) = d(c.Value) & "|" & c.Offset(0, 1)
        d2(c.Value) = d2(c.Value) & "|" & c.Offset(0, 2)
      End If
  Next c
  [f2].Resize(d.Count) = Application.Transpose(d.keys)
  [g2].Resize(d.Count) = Application.Transpose(d.items)
  [h2].Resize(d.Count) = Application.Transpose(d2.items)
End Sub

jb

Petit problème, je viens de faire le test avec une liste bien plus longue que celle présente dans le fichier, et cela ne fonctionne pas. Ne ne comprends pas grand chose dans ce code (aussi petit soit-il...), je ne voit pas d'ou l'erreur peut provenir, j'ai penser à des caractère spéciaux mais avant de traiter toute la liste je préfère demander.

losrque je lance le debug, le problème semble venir de la ligne [g2].Resize(d.Count) = Application.Transpose(d.items)

dans le fichier joint, le bouton sur la feuille source fonctionne bien avec les quelques lignes mais pas lorsque je remplace ces lignes par le contenu de la feuille 2.

Si quelqu'un à une idée d'ou le problème vient, je suis preneur.

Merci par avance pour vos contributions.

-

 

[maxis6582]

Re : liste de valeur différente

Y a t-il quelqu'un qui aurait une idée pour le problème de code?

Je suis complètement bloqué, j'ai passer une partie de la nuit à essayer de comprendre le problème sans succès... Et je suis certain que ce n'est pas grand chose.

Merci par avance

 

[david84]

Re : liste de valeur différente

Bonjour, salut Jacques

Peut-être que le problème soit dû au fait que les items du dictionnaires soient limités en caractères (ou alors il y a un problème lors de leur recopie dans la feuille).
En passant par un tableau cela semble être bon à 1ère vue (mais à vérifier dans le détail).

Sub Regroupe()
Dim T() As String, i&
Set d = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
ReDim T(1 To 65000, 1)

For Each c In Range("a2", [a65000].End(xlUp))
    If Not d.exists(c.Value) Then
        i = i + 1
        d(c.Value) = c.Offset(0, 1): T(i, 0) = d(c.Value)
        d2(c.Value) = c.Offset(0, 2): T(i, 1) = d2(c.Value)
    Else
        d(c.Value) = d(c.Value) & "|" & c.Offset(0, 1): T(i, 0) = d(c.Value)
        d2(c.Value) = d2(c.Value) & "|" & c.Offset(0, 2): T(i, 1) = d2(c.Value)
    End If
Next c

[f2].Resize(d.Count) = Application.Transpose(d.keys)
[g2].Resize(UBound(T), 2) = T
End Sub

Attention : pour que cela fonctionne les données doivent être triées comme cela est le cas dans l'exemple fourni.
A+

 

[maxis6582]

Re : liste de valeur différente

Bonjour, merci bien pour les explications, je crois que j'aurais pu chercher longtemps... Tout fonctionne impeccable. Passez une bonne journée.