Suppression de doublons dans une colonne

Jilde

XLDnaute Occasionnel
Bonjour les gens ;o) !

De retour avec mon bonnet d'âne ...

J'vous fais une récap' de ce que j'essaie de pondre (oui, oui, un âne qui pond, c'est pas courant ... Mais bon, de nos jours ...).

J'ai une liste de fichier (chemin + nom + extension) dans la colonne D, un fichier par cellule.

J'extrais les extensions de ces fichiers (.xls, .dg, .doc, .youh, .xfde, ...) dans la colonne F:
Code:
Sub extrait_extension()
For n = 1 To 100
  Range("f" & n) = UCase(Right(Range("d" & n), (InStr(1, StrReverse(Range("d" & n)), "."))))
Next
End Sub
(Merci le forum !!!)

Maintenant, j'aimerais simplifier la colonne F contenant toutes les extensions de fichier pour ne plus avoir de doublons, et ainsi avoir une liste exhaustive des extensions des fichiers de la colonne D.
Si j'ai deux fichiers Excel et trois fichiers Word, je veux n'avoir que deux cellules occupées dans la colonne F, F1 avec .XLS et F2 avec .DOC.

Cette liste sera ensuite récupérée dans une USF pour proposer à l'utilisateur de sélectionner le type de fichier, mais bon, c'est une autre histoire ...

At'chao ;o) !!
 

mromain

XLDnaute Barbatruc
Re : Suppression de doublons dans une colonne

Bonjour Jilde,
rebonjour tbft,

Voici un exemple :
VB:
Sub Test()
Dim monDico As Object, laCell As Range, extension As String

    Set monDico = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    For Each laCell In Range("D1:D" & Range("D" & Rows.Count).End(xlUp).Row)
        extension = UCase(Right(laCell.Text, Len(laCell.Text) - InStrRev(laCell.Text, ".")))
        monDico.Add extension, extension
    Next laCell
    Range("F1").Resize(monDico.Count, 1).Value = WorksheetFunction.Transpose(monDico.Items)
End Sub
a+
 
Dernière édition:

Jilde

XLDnaute Occasionnel
Re : Suppression de doublons dans une colonne

Bonjour tbft ;o) !

Oui, j'ai déjà trouver des choses, mais ça ne fait pas ce que je cherche et je n'arrive pas à modifier le code pour obtenir ce que je veux ...
(suppression de ligne au lieu de la cellulle, recherche des doublons dans plusieurs colonnes alors que je n'en traite qu'une seule ...)

Mais bon, je ne désespère pas, je continue à chercher !!!

Merci mromain !!
J'essaie ça de suite !!
 
Dernière édition:

CBernardT

XLDnaute Barbatruc
Re : Suppression de doublons dans une colonne

Bonjour à tous,

Une autre approche avec une boucle unique

Sub Transfert()
Dim Tablo, n As Integer, i As Integer, j As Integer
Tablo = Range("D1:D" & Range("D65536").End(xlUp).Row)
For i = 1 To UBound(Tablo, 1)
If Tablo(i, 1) <> "" Then
For j = i + 1 To UBound(Tablo, 1)
If UCase(Right(Tablo(j, 1), Len(Tablo(j, 1)) - InStrRev(Tablo(j, 1), "."))) = UCase(Right(Tablo(i, 1), Len(Tablo(i, 1)) - InStrRev(Tablo(i, 1), "."))) Then
Tablo(j, 1) = ""
End If
Next j
n = n + 1
Range("f" & n) = UCase(Right(Tablo(i, 1), Len(Tablo(i, 1)) - InStrRev(Tablo(i, 1), ".")))
End If
Next i
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 330
Messages
2 087 343
Membres
103 525
dernier inscrit
gbaipc