Conserver uniquement les valeurs uniques

lolopolo · 6 Décembre 2010

Bonjour,

Apres plusieurs recherches sur le forum et google, je vous demande de l'aide pour une opération qui me semble simple mais que je n'arrive pas à réaliser en formule.

Comment sur une colonne (50 000 entrées), conserver uniquement les données uniques et supprimer tous les doublons.
En exemple

Sur la liste suivante, je ne veux conserver que A,D,E,F,H
A
B
B
C
C
C
D
E
F
G
G
H

La fonction doublons d'excel ne m'interesse pas car elle me garde toutes les valeurs et supprime les doublons... Moi je cherche les valeurs uniques
Un grand merci!

pierrejean · 6 Décembre 2010

Re : Conserver uniquement les valeurs uniques

bonjour lolopolo

Vois si cela te convient

mromain · 6 Décembre 2010

Re : Conserver uniquement les valeurs uniques

Bonjour lolopolo et bienvenue sur le forum,
Bonjour pierrejean

Voici un essai :

VB:

'*** Les données à analyser sont en colonne A de la feuille "Feuil1"
Sub test()
Dim derLigne As Long, iLigne As Long, liste As String
    
    liste = ";"
    
    With ThisWorkbook.Sheets("Feuil1")
        
        'calculer la dernière ligne contenant les données
        derLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        
        'bouler sur toutes les lignes (de 1 à derLigne)
        For iLigne = derLigne To 1 Step -1
        
            'si ce n'est pas une valeur unique (dans la colonne A)
            If Application.WorksheetFunction.CountIf(.Range("A:A"), .Range("A" & iLigne)) <> 1 Then
                'ajouter la valeur = la liste
                liste = liste & .Range("A" & iLigne).Text & ";"
            End If
            
            'si la valeur de cette ligne est dans la liste
            If InStr(liste, ";" & .Range("A" & iLigne).Text & ";") <> 0 Then
                'effacer la ligne
                .Rows(iLigne).Delete
            End If
            
        Next iLigne
    End With
End Sub

a+

pierrejean · 6 Décembre 2010

Re : Conserver uniquement les valeurs uniques

Re

Mes excuses , je n'avais pas lu jusqu'au bout

Vois ceci

Edit: Salut mromain

lolopolo · 6 Décembre 2010

Re : Conserver uniquement les valeurs uniques

mromain à dit:

Bonjour lolopolo et bienvenue sur le forum,
Bonjour pierrejean

Voici un essai :

Code:

[COLOR=GREEN]'*** Les données à analyser sont en colonne A de la feuille "Feuil1"[/COLOR]
[COLOR=BLUE]Sub[/COLOR] test()
[COLOR=BLUE]Dim[/COLOR] derLigne [COLOR=BLUE]As Long[/COLOR], iLigne [COLOR=BLUE]As Long[/COLOR], liste [COLOR=BLUE]As String[/COLOR]
    
    liste = ";"
    
    [COLOR=BLUE]With[/COLOR] ThisWorkbook.Sheets("Feuil1")
        
        [COLOR=GREEN]'calculer la dernière ligne contenant les données[/COLOR]
        derLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        
        [COLOR=GREEN]'bouler sur toutes les lignes (de 1 à derLigne)[/COLOR]
        [COLOR=BLUE]For[/COLOR] iLigne = derLigne [COLOR=BLUE]To[/COLOR] 1 [COLOR=BLUE]Step[/COLOR] -1
        
            [COLOR=GREEN]'si ce n'est pas une valeur unique (dans la colonne A)[/COLOR]
            [COLOR=BLUE]If[/COLOR] Application.WorksheetFunction.CountIf(.Range("A:A"), .Range("A" & iLigne)) <> 1 [COLOR=BLUE]Then[/COLOR]
                [COLOR=GREEN]'ajouter la valeur = la liste[/COLOR]
                liste = liste & .Range("A" & iLigne).Text & ";"
            [COLOR=BLUE]End If[/COLOR]
            
            [COLOR=GREEN]'si la valeur de cette ligne est dans la liste[/COLOR]
            [COLOR=BLUE]If[/COLOR] InStr(liste, ";" & .Range("A" & iLigne).Text & ";") <> 0 [COLOR=BLUE]Then[/COLOR]
                [COLOR=GREEN]'effacer la ligne[/COLOR]
                .Rows(iLigne).Delete
            [COLOR=BLUE]End If[/COLOR]
            
        [COLOR=BLUE]Next[/COLOR] iLigne
    [COLOR=BLUE]End With[/COLOR]
[COLOR=BLUE]End Sub[/COLOR]

a+

Merci pour cette réponse mais c trop compliqué pour moi

lolopolo · 6 Décembre 2010

Re : Conserver uniquement les valeurs uniques

pierrejean à dit:
Re

Mes excuses , je n'avais pas lu jusqu'au bout

Vois ceci

Edit: Salut mromain

Merci bcp! C'est exactement ce que je recherchais!

Tonneau91 · 1 Décembre 2015

Re : Conserver uniquement les valeurs uniques

mromain à dit:

Bonjour lolopolo et bienvenue sur le forum,
Bonjour pierrejean

Voici un essai :

VB:

'*** Les données à analyser sont en colonne A de la feuille "Feuil1"
Sub test()
Dim derLigne As Long, iLigne As Long, liste As String
    
    liste = ";"
    
    With ThisWorkbook.Sheets("Feuil1")
        
        'calculer la dernière ligne contenant les données
        derLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        
        'bouler sur toutes les lignes (de 1 à derLigne)
        For iLigne = derLigne To 1 Step -1
        
            'si ce n'est pas une valeur unique (dans la colonne A)
            If Application.WorksheetFunction.CountIf(.Range("A:A"), .Range("A" & iLigne)) <> 1 Then
                'ajouter la valeur = la liste
                liste = liste & .Range("A" & iLigne).Text & ";"
            End If
            
            'si la valeur de cette ligne est dans la liste
            If InStr(liste, ";" & .Range("A" & iLigne).Text & ";") <> 0 Then
                'effacer la ligne
                .Rows(iLigne).Delete
            End If
            
        Next iLigne
    End With
End Sub

a+

Bonjour,

Je me permets de réactiver la discussion.

Le code ci-dessus marche parfaitement lorsque l'on souhaite conserver les valeurs uniques d'une seule colonne.

Pour ma part, je souhaite conserver les lignes uniques d'une base de données, c'est à dire incluant plusieurs colonnes.

J'essaie d'adapter le code sans grand succès.

Avez-vous une piste à me conseiller ?

D'avance, merci

pierrejean · 1 Décembre 2015

Re : Conserver uniquement les valeurs uniques

Bonjour Tonneau

Vois si cela te convient

Tonneau91 · 1 Décembre 2015

Re : Conserver uniquement les valeurs uniques

Bonjour Pierrejean,

Merci beaucoup pour votre réponse.

En fait c'est une combinaison de valeurs uniques qui m'intéresse.

Exemple pour cette base de données simplifiée :

A A B
C C A
A A C
A A B
A C A
A A C

Je voudrais obtenir seulement les lignes en rouge, c'est à dire celle qui sont uniques dans la base.

Seulement, certains caractères sont en doublons si on ne regarde qu'une seule colonne : Peu importe, je cherche à identifier les combinaisons uniques.

Encore merci de m'avoir répondu si vite.

Tonneau91 · 2 Décembre 2015

Re : Conserver uniquement les valeurs uniques

Bonjour,

Je pense avoir trouvé la solution en adaptant le premier code. Je transforme le Countif en Countifs en intégrant mes autres critères (c'est à dire mes autres colonnes). Ca à l'air de marcher.

Si vous avez des remarques je suis preneur, je suis novice en vba.

Ca donne ceci pour moi :

Code:

Sub test()
Dim derLigne As Long, iLigne As Long, liste As String
   
    liste = ";"
   
    With ThisWorkbook.Sheets("Feuil1")
       
        'calculer la dernière ligne contenant les données
       derLigne = .Range("A" & .Rows.Count).End(xlUp).Row
       
        'bouler sur toutes les lignes (de 1 à derLigne)
       For iLigne = derLigne To 1 Step -1
       
            'si ce n'est pas une valeur unique (dans la colonne A)
           If Application.WorksheetFunction.CountIfs(.Range("A:A"), .Range("A" & iLigne), .Range("B:B"), .Range("B" & iLigne), .Range("C:C"), .Range("C" & iLigne)) <> 1 Then
                'ajouter la valeur = la liste
               liste = liste & .Range("A" & iLigne).Text & ";"
            End If
           
            'si la valeur de cette ligne est dans la liste
           If InStr(liste, ";" & .Range("A" & iLigne).Text & ";") <> 0 Then
                'effacer la ligne
               .Rows(iLigne).Delete
            End If
           
        Next iLigne
    End With
End Sub

BOISGONTIER · 2 Décembre 2015

Re : Conserver uniquement les valeurs uniques

Bonsoir,

Code:

Sub NonDoublons()
 Set d = CreateObject("Scripting.Dictionary")
 Tbl = Range("a2:c" & [a65000].End(xlUp).Row)
 For i = LBound(Tbl) To UBound(Tbl)
   clé = Tbl(i, 1) & "|" & Tbl(i, 2) & "|" & Tbl(i, 3)
   d(clé) = d(clé) + 1
 Next i
 j = 0
 Dim b(): ReDim b(1 To d.Count, 1 To 3)
 For Each c In d.keys
   If d(c) = 1 Then
     j = j + 1
     a = Split(c, "|")
     b(j, 1) = a(0): b(j, 2) = a(1): b(j, 3) = a(2)
   End If
 Next c
 [e2].Resize(j, 3) = b
End Sub

0,03 sec pour 5.000 lignes

JB

tikljo · 20 Novembre 2019

Sinon une version plus simple sans macro :
faire un concat des cellules A1;B1; etc) dans la cellule Z1 par exemple.
Dérouler le concat sur la liste de valeur.
puis faire un mise en forme conditionnelle des valeurs uniques de la colonne Z

Conserver uniquement les valeurs uniques

lolopolo

XLDnaute Nouveau

pierrejean

XLDnaute Barbatruc

Pièces jointes

mromain

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

Pièces jointes

lolopolo

XLDnaute Nouveau

lolopolo

XLDnaute Nouveau

Tonneau91

XLDnaute Nouveau

pierrejean

XLDnaute Barbatruc

Pièces jointes

Tonneau91

XLDnaute Nouveau

Tonneau91

XLDnaute Nouveau

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

tikljo

XLDnaute Nouveau

Discussions similaires