[RESOLU] Extraire Sans Doublons Avec 1 Critère Nom

Le_Troll_Du_27 · 11 Janvier 2016

Bonjour le Forum

Je voudrais pouvoir extraire sans doublons une liste en "C" référence d'une autre liste en A ou le critère est la partie d'un nom de cette propre liste et ranger par ordre alphabétique en O.

Dsl cela n'a pas l'air tes clair. Je joins le fichier pour y voir plus clair.

Code:

Sub ItemsUniquesMainOeuvre()
    Sheets("BDD").Select
    Application.ScreenUpdating = False
    ' Déclaration d'une nouvelle collection
    Dim NoDupes As New Collection
    ' Sélection de la plage à traiter
    c = Range([C2], [C65536].End(xlUp)).Value
    [C1].Select
    ' Désactivation du gestionnaire d'erreurs
    On Error Resume Next
    ' Boucle pour récupérer la collection d'items uniques
    For J = 1 To UBound(c, 1)
        NoDupes.Add c(J, 1), CStr(c(J, 1))
    Next J
    ' Réactivation du gestionnaire d'erreurs
    On Error GoTo 0
    ' Récupération des items uniques
    For I = 1 To NoDupes.Count
        Cells(I + 1, 17).Value = NoDupes(I)
    Next I

End Sub

Cordialement

Laurent

Bebere · 11 Janvier 2016

Re : Extraire Sans Doublons Avec 1 Critère Nom

bonjour
à tester pour dictionary tu peux mettre Set d = CreateObject("Scripting.Dictionary") et tu enlèves d As New Dictionary

Sub MainOeuvreUnic() 'pour dictionary cocher microsoft.scripting runtime dans outils,références
Dim a, d As New Dictionary, i As Long, x As String, y As String

Sheets("BDD").Range([Q2], [Q65536].End(xlUp)).ClearContents
a = Sheets("BDD").[A1].CurrentRegion
x = UCase("main") ' d'oeuvre") 'le oe de oeuvre pose problème
For i = 2 To UBound(a)
y = UCase(Left(a(i, 1), Len(x)))
If y = x Then d(a(i, 3)) = a(i, 3)
Next i
Sheets("BDD").[Q2].Resize(d.Count) = Application.Transpose(d.Items)
End Sub

Jacou · 11 Janvier 2016

Re : Extraire Sans Doublons Avec 1 Critère Nom

Bonjour Laurent
est-ce que cet essai répond à ton attente?

Jacou

Le_Troll_Du_27 · 11 Janvier 2016

Re : Extraire Sans Doublons Avec 1 Critère Nom

Bonjour le forum, le fil, Bebere, Jacou

J'ai essayé ton code

Code:

Bebere

et il doit y avoir une erreur

Et celui de

Code:

Jacou

il correspond a mes attentes.

Merci
Amicalement

Laurent

laetitia90 · 11 Janvier 2016

Re : [RESOLU] Extraire Sans Doublons Avec 1 Critère Nom

bonjour tous

par curiosité j'ai testé
le code de l'ami Bebere fonctionne trés bien tu as pas bien lu ce qu' il a ecrit !!!

Code:

Dim a, d As Object, i As Long, x As String, y As String
Set d = CreateObject("scripting.dictionary")
Sheets("BDD").Range([Q2], [Q65536].End(xlUp)).ClearContents
a = Sheets("BDD").[A1].CurrentRegion
x = UCase("main") ' d'oeuvre") 'le oe de oeuvre pose problème
For i = 2 To UBound(a)
y = UCase(Left(a(i, 1), Len(x)))
If y = x Then d(a(i, 3)) = a(i, 3)
Next i
Sheets("BDD").[Q2].Resize(d.Count) = Application.Transpose(d.Items)

Jacou attention a l'utilisation d'une Collection sur les grandes plages???

Bebere · 11 Janvier 2016

Re : [RESOLU] Extraire Sans Doublons Avec 1 Critère Nom

bonjour Laetitia,Jacou
je m'en tiens à dictionary qui est bien plus performant
y a t'il un moyen d'éviter le problème oe qui se met parfois accolé

Le_Troll_Du_27 · 11 Janvier 2016

Re : [RESOLU] Extraire Sans Doublons Avec 1 Critère Nom

Bonjour le forum, le fil
C'est exact , j'ai mal recopié les instructions de Bebere, je suis navré, je l'ai réessayer avec les instructions est il fonctionne très bien.
Dsl de ma réponse tardive j'étais occupé.

Amicalement

Laurent

Jacou · 13 Janvier 2016

Re : [RESOLU] Extraire Sans Doublons Avec 1 Critère Nom

Bonjour le forum, bonjour laetitia,
tu as sans doute raison quant à l'utilisation de "collections" que personnellement je n'utilise pas.
je me suis contenté de reprendre le code initial de Laurent pour le compléter.
Jacou

Jacou · 13 Janvier 2016

Re : [RESOLU] Extraire Sans Doublons Avec 1 Critère Nom

Bonjour bebere,
pour éviter le problème du e dans l'o, je testerais les deux :

if (...) = "main d'oeuvre" or (...) = "main d’œuvre" then

bonne nuit
Jacou

ChTi160 · 13 Janvier 2016

Re : [RESOLU] Extraire Sans Doublons Avec 1 Critère Nom

Bonjour Laurent
Bonjour le fil,Le Forum
ou peut être en utilisant la Fonction Like
Ex :

VB:

If StringCompare Like "main d*" then

Bonne journée
Amicalement
Jean Marie

Bebere · 13 Janvier 2016

Re : [RESOLU] Extraire Sans Doublons Avec 1 Critère Nom

Bonjour Jean Marie,Jacou ,Laurent,Laetitia
je me suis fait cette réflexion car dans le code il y a
x=ucase("main d'oeuvre") et y =ucase(a(i,1),len(x))
x donne "MAIN D'OEUVRE" et y donne le OE ensemble et un espace en plus à la fin

[RESOLU] Extraire Sans Doublons Avec 1 Critère Nom

Le_Troll_Du_27

XLDnaute Occasionnel

Pièces jointes

Bebere

XLDnaute Barbatruc

Jacou

XLDnaute Impliqué

Pièces jointes

Le_Troll_Du_27

XLDnaute Occasionnel

laetitia90

XLDnaute Barbatruc

Bebere

XLDnaute Barbatruc

Le_Troll_Du_27

XLDnaute Occasionnel

Jacou

XLDnaute Impliqué

Jacou

XLDnaute Impliqué

ChTi160

XLDnaute Barbatruc

Bebere

XLDnaute Barbatruc

Discussions similaires