Créer une liste unique/supprimer doublons

Le 31/03/2015 à 00:07

Bonsoir

dans le fichier ci joint, j'ai une liste de n°, je souhaiterais avoir la possibilité de supprimer les doublons et d'afficher la liste sans doublon dans une 2ne feuille

quelqu'un aurait-il une idée ?

merci

Asso 132

63creer-un-listing-unique.xlsx (9.38 Ko)
Le 31/03/2015 à 01:44

Bonsoir,

en A2 :

=SIERREUR(PETITE.VALEUR(SI(NB.SI(A$1:A1;base!A$2:A$32)=0;base!A$2:A$32);1);"")

@ valider par Ctrl+Shift+Enter

@ tirer vers le bas

@ + +

Le 31/03/2015 à 01:46

Bonjour,

rien de plus facile via un filtre avancé …

En dehors de consulter l'aide d'Excel, voici une astuce : lorsque la feuille de destination est différente de la feuille source,

se placer sur la feuille de destination avant de paramétrer un filtre avancé …

Le 31/03/2015 à 01:58

Bonsoir

merci à tous

Il n y a pas une solution vba pour ne pas mettre des formules dans les cellules? et pouvoir les supprimer par inadvertance ?

merci

asso1321

Le 31/03/2015 à 03:55

Et bien oui ! Via un filtre avancé …

Le 31/03/2015 à 06:03
asso132 a écrit :

Il n y a pas une solution vba

en VBA

Option Explicit
Private Sub trier_sans_doublons()
    Dim tmpRange() As Variant
    Dim varRange() As Variant
    Dim onglet As String, fichier As String, actuel As String, der, deb, i, Reponse

    Dim dico As Object
    Set dico = CreateObject("Scripting.Dictionary")

    der = Sheets("base").[A65000].End(xlUp).Row
    deb = 2
    tmpRange = Sheets("base").Range("A" & deb & ":A" & der).Value
    For i = 1 To UBound(tmpRange)
        dico(tmpRange(i, 1)) = ""
    Next i
    varRange = dico.keys
    QuickSort varRange
    For i = 1 To UBound(varRange)
        Sheets("listing").Range("A" & i + 1).Value = varRange(i)
    Next i
    ReDim tmpRange(0)

End Sub

Public Sub QuickSort(vArray As Variant, _
  Optional ByVal inLow As Long = -1, _
  Optional ByVal inHi As Long = -1)
  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long
  inLow = IIf(inLow = -1, LBound(vArray), inLow)
  inHi = IIf(inHi = -1, UBound(vArray), inHi)
  tmpLow = inLow
  tmpHi = inHi
  pivot = vArray((inLow + inHi) \ 2)
  While (tmpLow <= tmpHi)
     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend
     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend
     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If
  Wend
  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub
Le 31/03/2015 à 07:44

Bonjour,

Avec fonction perso matricielle (la liste sans doublons est maintenue à jour automatiquement)

sélectionner a2:a20

=SansDoublonsTrié(base!A2:A47)

valider avec maj+ctrl+entrée

Option Compare Text
Function SansDoublonsTrié(champ As Range)
  Set mondico = CreateObject("Scripting.Dictionary")
  mondico.CompareMode = vbTextCompare
  temp = champ
  For Each c In temp
    If c <> "" Then mondico(c) = ""
  Next c
  Dim b()
  ReDim b(1 To Application.Caller.Rows.Count)
  i = 1
  For Each c In mondico.keys
    b(i) = c
    i = i + 1
  Next
  Call tri(b, 1, mondico.Count)
  SansDoublonsTrié = Application.Transpose(b)
End Function

Sub tri(a, gauc, droi)          ' Quick sort
 ref = a((gauc + droi) \ 2)
 g = gauc: d = droi
 Do
     Do While a(g) < ref: g = g + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If g <= d Then
       temp = a(g): a(g) = a(d): a(d) = temp
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call tri(a, g, droi)
 If gauc < d Then Call tri(a, gauc, d)
End Sub

Ceuzin

66creer-un-listing-unique.zip (12.85 Ko)
Le 31/03/2015 à 10:04

Maximum 5 lignes de code via un filtre avancé ‼ En trois instructions …

Steelson, ton code de mon côté oublie le premier élément et double le dernier …

Le 31/03/2015 à 10:53

Bonjour,

Une proposition à étudier.

Cdlt.

Public Sub Demo()
    Feuil2.Cells.Clear
    Feuil1.Cells(1).CurrentRegion.Copy Destination:=Feuil2.Cells(1)
    With Feuil2
        With .Cells(1).CurrentRegion
            .RemoveDuplicates Columns:=1, Header:=xlYes
            .Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlYes
        End With
    End W
Le 31/03/2015 à 10:59

Cela c'est bien ! Mais seulement à partir de la version 2007 d'Excel …

Le filtre avancé est exploitable déjà dans les versions plus anciennes et, en une unique instruction, copie et enlève les doublons !

Le 31/03/2015 à 11:12

Bonjour Marc L,

J'ai vérifié la version d'Excel avant de poster.

Cdlt.

Le 31/03/2015 à 11:24

C'était juste pour rappeler l'efficacité du filtre avancé et ce, depuis des lustres !

Capable de traiter des centaines de milliers de lignes instantanément et évitant de nombreuses usines à gaz …

Le 01/04/2015 à 00:42

Bonsoir à tous

Merci pour vos réponses

Steelton : je n'ai pas réussi à faire fonctionner

jean eric: sub demo fonctionne à merveille avec ma version d excel

ça fonctionne comment les filtres avancées ?

merci

asso132

Rebonsoir à tous

Jean-Eric: si mes données sont en colonne AB (sauf ligne 1)

et doivent être copiées (uniquement cette colonne) en feuille "etab" et colonne A (à la place de feuil2)

Comment dois je modifier la sub ?

merci

asso132

    Public Sub Demo()
        Feuil2.Cells.Clear
        Feuil1.Cells(1).CurrentRegion.Copy Destination:=Feuil2.Cells(1)
        With Feuil2
            With .Cells(1).CurrentRegion
                .RemoveDuplicates Columns:=1, Header:=xlYes
                .Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlYes
            End With
        End With

    End Sub
Le 01/04/2015 à 01:20
Marc L a écrit :

Steelson, ton code de mon côté oublie le premier élément et double le dernier …

Bonjour,

pour le dernier, non, tu as dû faire tourner 2 fois la macro, et comme les nombres sont aléatoires et changent à chaque fois ...

Par contre merci pour ta remarque, ma méthode omet le premier caractère / valeur !

Néanmoins la méthode précédentesub demo()est bien plus simple !

Ce qui suit c'est le code que j'utilise pour initialiser un userform de saisie prédictive.

Voici la correction en vba :

Option Explicit
Private Sub trier_sans_doublons()
    Dim tmpRange() As Variant
    Dim varRange() As Variant
    Dim onglet As String, fichier As String, actuel As String, der, deb, i, Reponse

    Dim dico As Object
    Set dico = CreateObject("Scripting.Dictionary")

    der = Sheets("base").[A65000].End(xlUp).Row
    deb = 2
    tmpRange = Sheets("base").Range("A" & deb & ":A" & der).Value
    For i = 1 To UBound(tmpRange)
        dico(tmpRange(i, 1)) = ""
    Next i
    varRange = dico.keys
    QuickSort varRange
    For i = 0 To UBound(varRange)
        Sheets("listing").Range("A" & i + 2).Value = varRange(i)
    Next i
    ReDim tmpRange(0)

End Sub

Public Sub QuickSort(vArray As Variant, _
  Optional ByVal inLow As Long = -1, _
  Optional ByVal inHi As Long = -1)
  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long
  inLow = IIf(inLow = -1, LBound(vArray), inLow)
  inHi = IIf(inHi = -1, UBound(vArray), inHi)
  tmpLow = inLow
  tmpHi = inHi
  pivot = vArray((inLow + inHi) \ 2)
  While (tmpLow <= tmpHi)
     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend
     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend
     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If
  Wend
  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub
19creer-un-listing-unique.xlsm (17.41 Ko)
Le 01/04/2015 à 02:26

J'avais enlevé la fonction ALEA en ne conservant que les valeurs …

Ce coup-ci c'est bon. Résultat identique avec seulement trois instructions dont une pour le filtre avancé,

c'est encore plus simple que la démo de Jean-Eric …

asso132 a écrit :

ça fonctionne comment les filtres avancées ?]

Simplement - avec l'astuce déjà indiquée - juste en répondant bien à l'assistant, c'est visuel …

Sinon au cas où il y a l'aide d'Excel. Si besoin, en activant le Générateur de macros, une base de code est livrée sur un plateau.

En cas d'échec - improbable car des gamins d'école élémentaire (CM1/CM2 ~10ans) y sont arrivés - joindre alors

un classeur devant être l'exact reflet de la structure réelle …

L'effort fait les forts …

Rechercher des sujets similaires à "creer liste unique supprimer doublons"