Problème extraction sans doublon

[gillmo]

Hello le forum,

Voilà j'ai un petit souci avec un code VBA pour extraire des données sans doublon. Je souhaite extraire une liste de numéro mais j'en ai certains qui sont omis.

Ex : dans la liste, il y a le code 88, et 388. La macro va prendre l'un des deux mais pas les deux.

Je vous joins un fichier pour que ce soit plus compréhensible.


Merci d'avance pour votre aide

 

[gillmo]

Re : Problème extraction sans doublon

Je pense avoir trouvé la solution en indiquant après find l'expression lookat:=xlWhole

 

[Guest]

Re : Problème extraction sans doublon

Bonjour,

Et simplement comme ceci:

Sub ExtractionSansDoublon()
    Application.Calculation = xlCalculationManual
    With ThisWorkbook
    .Sheets("Feuil2").Range("A:A").ClearContents
    .Sheets("Feuil1").Range("A:A").AdvancedFilter xlFilterCopy, , .Sheets("Feuil2").Range("A1"), True
    End With
    Application.Calculation = xlCalculationAutomatic
End Sub

Ou plus compliqué:

Sub ExtractionSansDoublon2()
    Dim oList As Object
    Dim t As Variant, itm As Variant
    Set oList = CreateObject("system.collections.arraylist")
    With ThisWorkbook
        .Sheets("Feuil2").Range("A:A").ClearContents
        With .Sheets("Feuil1")
            t = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value
            For itm = LBound(t) To UBound(t)
                If Not oList.contains(t(itm, 1)) Then oList.Add t(itm, 1)
            Next
        End With
        If oList.Count > 0 Then
            oList.Sort
            .Sheets("Feuil2").Range("A2").Resize(oList.Count) = Application.Transpose(oList.toarray())
        End If
    End With
    
End Sub

A+

 

[BOISGONTIER]

Re : Problème extraction sans doublon

Bonjour,

Sub ExtractionSansDoublon()
 Set mondico = CreateObject("Scripting.Dictionary")
 Set f1 = Sheets("feuil1")
 a = f1.Range("a2:a" & f1.[a65000].End(xlUp).Row).Value
 For Each c In a
    mondico(c) = ""
 Next c
 [a2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
End Sub

0,04 sec pour 16.000 lignes

JB

 

[DoubleZero]

Re : Problème extraction sans doublon

Bonjour, gillmo, le Forum,

Un essai avec ce code, lequel doit être logé dans un module et non pas dans "ThisWorkbook" :

Option Explicit
Sub Extraire_sans_doublon()
Sheets("Feuil2").Activate
Columns(1).Clear
Range("Feuil1!Criteria").AdvancedFilter Action:=xlFilterCopy, CopyToRange:= _
        Range("a1"), Unique:=True
Range("a1").Sort Key1:=Range("a1"), Order1:=xlAscending, Header:=xlYes
End Sub

A bientôt 🙂

P. S. : Bonjour, Hasco 🙂, BOISGONTIER 🙂

 

[gillmo]

Re : Problème extraction sans doublon

bonjour à tous,

merci de vos différents retours. Je vois qu'il y a pas mal de solutions.

Je vais changer mon code pour prendre celui de boisgontier car il est court et très rapide. Cela dit, je garde en mémoires vos codes qui pourront me servir pour d'autres documents.