Encore une histoire de doublons..

[xscream]

Bonjour,

J'ai une liste, tel que :

VM5
VM5
VM6
VM7

Je souhaite que cette liste soit sans doublons de manière à ce que n'apparaisse uniquement les valeurs uniques, soit une liste qui serait :

VM6
VM7

et non pas :

VM5
VM6
VM7

La question a peut-être déjà été posé un jour mais les applications ne sont pas toujours très clairs, alors je me permet de vous reposer la question simplement.

Merci d'avance pour votre aide!

 

[youky(BJ)]

Re : Encore une histoire de doublons..

Bonjour,
Avec cette macro j'ai pas prévu de ligne entête

Dim tx(1000)' si besoin augmenter
For k = 1 To [A65000].End(3).Row
If Application.CountIf([A:A], Cells(k, 1)) = 1 Then _
n = n + 1: tx(n) = Cells(k, 1)
Next
[A:A].Value = ""
For k = 1 To n: Cells(k, 1) = tx(k): Next 'si entete 2 to n+1

 

[MJ13]

Re : Encore une histoire de doublons..

Bonjour Xcream, Youky

Super Youky ta routine.

Et si je veux supprimer les doublons comme on le fait normalement (cela pourrait me servir bientôt). Comment faire?

Merci d'avance.

 

[xscream]

Re : Encore une histoire de doublons..

Merci, ça a l'air de très bien fonctionner!

Je pense que pour la suppression normale de doublons (si je comprends bien le sens du terme "normal"), il suffit d'utiliser la commande existante dans Excel !

 

[MJ13]

Re : Encore une histoire de doublons..

Re Xcream

il suffit d'utiliser la commande existante dans Excel !

Mais en VBA?

Merci de ta réponse.

 

[youky(BJ)]

Re : Encore une histoire de doublons..

Rebonjour,
Voici un code qui supprime les doublons et les mets par ordre croissant.
Entête non prévue...

Private Sub CommandButton1_Click()
Set dico = CreateObject("Scripting.Dictionary")
For Each c In range("A1:A" & [A65536].end(3).row)
If Not dico.Exists(c.Value) And c.Value <> "" Then _
dico.Add c.Value, c.Value
Next c
a = dico.items 'Obtient les éléments
For k = 1 To UBound(a) 'trie des éléments
 For b = k + 1 To UBound(a)
   If a(b) < a(k) Then
   temp = a(b)
   a(b) = a(k)
   a(k) = temp
   End If
 Next 
Next 
For k = 0 To dico.Count - 1 'pose des éléments en col B
Feuil1.cells(k+1,2)=a(k)
Next
End Sub

 

[MJ13]

Re : Encore une histoire de doublons..

Re Youky

ENcore merci pour tes codes.

Euh désolé, c'est moi, je crois que c'était à cause de Feuil1.
Je vérifie.

 

[youky(BJ)]

Re : Encore une histoire de doublons..

For k = 0 To UBound(a) 'trie des éléments
au lieu de:
For k = 1 To UBound(a) 'trie des éléments

Désolé...

 

[MJ13]

Re : Encore une histoire de doublons..

Re Youky

Voici le fichier DOUBLONS fait grâce a tes codes.

Encore merci, cela va bien me servir.

 

[xscream]

Re : Encore une histoire de doublons..

Bonjour,

La colonne contient des données de deux sources différentes, repérées par un code couleur (par exemple). Une fois les doublons supprimées avec la macro, est-il possible de garder quelquechose qui différenciera les données de la source 1 de la source 2 ?

Merci

 

[youky(BJ)]

Re : Encore une histoire de doublons..

Hé bien voilà.....
avec le petit plus.

Dim tx(1000) ' si besoin augmenter
Dim coul(1000)
For k = 1 To [A65000].End(3).Row
If Application.CountIf([A:A], Cells(k, 1)) = 1 Then _
n = n + 1: tx(n) = Cells(k, 1): coul(n) = Cells(k, 1).Interior.ColorIndex
'si couleur fonte .Font.ColorIndex  au lieu .Interior.....
Next
[A:A].Value = "": [A:A].Interior.ColorIndex = xlNone
For k = 1 To n
Cells(k, 1) = tx(k)
Cells(k, 1).Interior.ColorIndex = coul(k)
Next 'si entete 2 to n+1

 

[xscream]

Re : Encore une histoire de doublons..

Encore merci !

Youki, j'aurais une dernière requête : le moyen de ne garder que les doublons d'une liste, à l'inverse de ma première demande. Je ne sais pas ce qu'il faut changer dans le code pour ça.

Merci d'avance!

 

[BOISGONTIER]

Re : Encore une histoire de doublons..

Bonjour,

Liste en A2,...

  Set MonDico = CreateObject("Scripting.Dictionary")
  Set MonDico2 = CreateObject("Scripting.Dictionary")
  For Each c In Range([a2], [a65000].End(xlUp))
    If MonDico.exists(c.Value) Then MonDico2.Item(c.Value) = c.Value
    MonDico.Item(c.Value) = c.Value
  Next c
 [E2].Resize(MonDico2.Count, 1) = Application.Transpose(MonDico2.items)

Les non doublons:

0,4 sec pour 10.000 éléments (11 sec avec CountIf)

Set mondico = CreateObject("Scripting.Dictionary")
   For Each c In Range("a2", [a65000].End(xlUp))
     mondico.Item(c.Value) = mondico.Item(c.Value) + 1
   Next c
   Set mondico2 = CreateObject("Scripting.Dictionary")
   For Each c In mondico.keys
     If mondico(c) = 1 Then mondico2.Add c, 1
   Next c
   [c2].Resize(mondico2.Count, 1) = Application.Transpose(mondico2.keys

JB

 

[xscream]

Re : Encore une histoire de doublons..

Bonjour,

Merci pour votre fichier mais il y a une erreur lors de l'execution à cette ligne. Pouvez-vous me dire ce qu'il faut faire ?

  [E2].Resize(MonDico2.Count, 1) = Application.Transpose(MonDico2.items)

 

[xscream]

Re : Encore une histoire de doublons..

Re bonjour,

Je fais un UP sur cette discussion pour ne pas créer un nouveau sujet !

A l'inverse de les supprimer, je souhaite extraire d'une liste que les doublons! Quelqu'un peut m'aider ?

Merci d'avance