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

[Le_Troll_Du_27]

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.

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]

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]

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]

Re : Extraire Sans Doublons Avec 1 Critère Nom

Bonjour le forum, le fil, Bebere, Jacou

J'ai essayé ton code

Bebere

et il doit y avoir une erreur

Et celui de

Jacou

il correspond a mes attentes.

Merci
Amicalement

Laurent

 

[laetitia90]

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 !!!

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]

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]

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]

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]

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]

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 :

If StringCompare Like "main d*" then

Bonne journée
Amicalement
Jean Marie

 

[Bebere]

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