Extraction données avec remplacement des doublons

Bonjour,

Alors voilà, comme expliquer dans le titre, je cherche à extraire des données sans doublons.

Je m'explique :

mon outils porte sur les rotations de personnes dans 5 polyvalences (chauffeur, tri-carton, secrétaire, agent de quai, cariste).

J'ai donc une liste pour chaque polyvalence avec les personnes qui peuvent réaliser cette polyvalence.

A côté, j'ai un tableau où je souhaite extraire mes données.

Voici mon problème :

Comme une personne ne peut pas être à deux postes à la fois, je souhaite que si la personne apparaît plusieurs fois, elle soit remplacer par la personne suivante de la liste.

Exemple : La "personne 1" est à la fois dans la liste chauffeur et cariste. Je fais mon rechercheV pour chauffeur donc il me donne "Personne 1". Ensuite je fais mon rechercheV pour cariste et il me redonne "Personne 1". C'est ici que je voudrais trouver une formule qui permet de remplacer le "personne 1" de cariste par la personne suivante de la liste cariste.

j'ajoute mon fichier excel pour plus de clarté dans mes paroles. Tout est sur "feuil1"

Merci d'avance.

Bonsoir GregTH, le forum

Dans la Feuil1, je me suis contenté d'effacer tes doublons.

Option Explicit

Sub Efface_doublons()
Dim r As Range, w
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In Union(Range("c4:c36"), Range("e4:e33"), Range("g4:g46"), Range("i4:i36"), Range("k4:k39"))
            If Not .exists(r.Value) Then
                .Item(r.Value) = r.Address
            Else
                r.ClearContents
            End If
        Next
    End With
End Sub

klin89

Bonjour Klin89, merci pour ta réponse!

Malheuresement, ce que tu me proposes me retire tous mes doublons de ma "feuil1" alors que je veux juste retirer ceux du petit tableau qui est droite.. pour ensuite pouvoir les remplacer.

Re GregTH,

C'est tellement clair

Option Explicit

Sub Efface_doublons()
Dim r As Range
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In Sheets("Feuil1").Range("o8:o20")
            If Not .exists(r.Value) Then
                .Item(r.Value) = r.Address
            Else
                'r.ClearContents 'efface
                'pour visualiser les doublons
                r.Interior.ColorIndex = 42
            End If
        Next
    End With
End Sub

klin89

Re, klin89

Merci pour ton aide! Désolé d'être peu clair mais je suis vraiment débutant là dedans..

Aurais-tu une idée sur comment je pourrais faire pour remplacer les doublons identifiés par la personne le liste qui suit ?

Par exemple : le doublons "personne 2" de cariste soit remplacer par la "personne 8" et que "personne 4" soit remplacer par la "personne 13".. Et ainsi de suite..

Re GregTH,

Un essai mais je ne comprends pas vraiment ta logique

Attention aux espaces en début ou fin de chaine de caractères, cela fausse le résultat pour la comparaison des doublons.

Option Explicit

Sub test()
Dim dico As Object, r As Range, a, i As Long, j As Byte, txt As String
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Feuil1").Range("B3").CurrentRegion.Resize(, 10)
        a = Application.Index(.Value, Evaluate("row(1:" & _
                                               .Rows.Count & ")"), Array(2, 4, 6, 8, 10))
    End With
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1) - 1
            For j = 1 To UBound(a, 2)
                If Not IsEmpty(a(i, j)) Then
                    txt = Join$(Array(a(1, j), a(i, j)))
                    dico(txt) = a(i + 1, j)
                End If
            Next
        Next
        For Each r In Sheets("Feuil1").Range("o8:o20")
            If Not .exists(r.Value) Then
                .Item(r.Value) = r.Address
            Else
                txt = Join$(Array(r.Offset(, 1), r))
                If dico.exists(txt) Then
                    r.Interior.ColorIndex = 42
                    r.Value = dico.Item(txt)
                End If
            End If
        Next
    End With
End Sub

klin89