Localiser les doublons dans une colonne

Florian699

XLDnaute Nouveau
Bonjour à tous

j'ai le problème suivant :
j'ai une feuille excel avec dans la colonne A une liste de 10 000 mots.
Je souhaite rechercher les doublons (et il y en a !!) dans cette colonne A, afin de les supprimer si besoin. Les doublons seraient mis en surbrillance mais ce qui m'aiderait beaucoup c'est que dans une colonne B, et dans la cellule à coté de chaque mot cela me met le n° de la cellule ou se trouve le ou les doublons.

Comme cela je pourrai aller directement sur la ou les cellules où se trouvent les doublons (si les n° de cellules sont cliquables) pour voir si je dois les supprimer ou pas.
J'ai mis un fichier excel pour montrer ce que je recherche.

Si quelqu'un peut m'aider, je le remercie d'avance

Florian
 

Pièces jointes

  • test recherche doublons avec n° de cellules.xls
    20.5 KB · Affichages: 39

Florian699

XLDnaute Nouveau
Bonjour Pierrejean

je te remercie car c'est bien cela que je cherchais !!

peux-tu encore améliorer le système en mettant la cellule des doublons en jaune par exemple pour vite les repérer + mettre le n°de cellule ou se trouve le/les doublons, cliquable pour que quand je clique dessus le/les n° de cellules, cela m'emmène directement à la ligne où j'ai mon/mes doublons ?

merci d'avance
 

gosselien

XLDnaute Barbatruc
re,

et ceci pour repérer les *stricts* doublons de la colonne à choisir :)
VB:
Sub GroupColors()    ' permet de repérer facilement les doublons d'une liste
Dim Couleurs, monDico, c, Nocoul, Colonne, Zone, Fin, LastC, Clé, Zone2
Couleurs = Array(6, 10, 14, 15, 17, 20, 22, 23, 24, 26, 28, 31, 33, 34, 35, 36, 37, 38, 39, 40, 42, 43, 44, 45, 46, 50, 53)
Set monDico = CreateObject("Scripting.Dictionary"): monDico.CompareMode = 1 ' tout en minuscule !
Colonne = InputBox("Quelle colonne à regrouper par couleur " & Chr(10) & "en lettres, pas de chiffre !!!")
If Colonne = "" Then Exit Sub
If Not ColonneValideAdeps(Colonne) Then Exit Sub
Fin = Range(Colonne & "65000").End(xlUp).Row
Set Zone = Range(Colonne & "2", Colonne & Fin)
On Error Resume Next: On Error GoTo 0
For Each c In Zone
  If Left(c, 1) = "#" Then MsgBox ("N/A !!!"): Exit Sub
  If c <> "" Then monDico.Item(c.Value) = monDico.Item(c.Value) + 1
Next c
LastC = Range("IV4").End(xlToLeft).Column
For Each c In Zone ' Range(Colonne & "2", Colonne & "65000").End(xlUp)
  If c <> "" Then
    Nocoul = (Application.Match(c.Value, monDico.Keys, 0)) Mod UBound(Couleurs)
        Range(Cells(c.Row, 1), Cells(c.Row, LastC)).Interior.ColorIndex = Couleurs(Nocoul)
    End If
Next c
[A1].Select
End Sub
 

pierrejean

XLDnaute Barbatruc
Re
A tester:
VB:
Sub test()
tablo = Range("A2:Z" & Range("A" & Rows.Count).End(xlUp).Row) 'tableau de A a Z
Set dico = CreateObject("Scripting.dictionary")
For n = LBound(tablo, 1) To UBound(tablo, 1)
   x = tablo(n, 3) & "/" & tablo(n, 13) ' 3 =colonneC 13 =colonne M
   dico(x) = dico(x) & "C" & n + 1 & ","
Next
a = dico.keys
b = dico.items
For n = LBound(a) To UBound(a)
   For m = LBound(tablo, 1) To UBound(tablo, 1)
    If a(n) = tablo(m, 3) & "/" & tablo(m, 13) Then
        xx = Replace(b(n), "C" & m + 1 & ",", "")
        If xx <> "" Then tablo(m, 26) = Left(xx, Len(xx) - 1) ' 26=colonne Z
    End If
   Next
Next
Range("A2").Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
End Sub
 

Statistiques des forums

Discussions
314 660
Messages
2 111 625
Membres
111 237
dernier inscrit
vinthi