Supprimer des doublons dans une ligne

Bonjour, j'aimerais un code qui supprime les doublons dans une ligne.

Merci

Bonjour,

Pourrais-tu joindre un exemple de ton fichier pour que nous puissions t'aider ?

Merci

Bonjour

Pour bâtir un code, il est préférable de savoir comment est structuré ton fichier.

Regarde joindre un fichier, en haut et à droite de cette page.

Cordialement

Je commence un programme qui tire aléatoirement des questions positionnées dans une première feuille et les placent dans une autre feuille sous le nom des personnes qui devront y répondre. Les noms sont positionnés de B1 à L1.

Je ne sais pas comment faire pour que les questions ne soient tirées qu'une fois (les personnes ne devront jamais avoir la même question).

Si en plus les personne peuvent avoir plusieurs questions ...

J'ai fais un code pour chaque colonne que j'ai repris d'une discussion sur ce site, j'ai pas encore tout compris mais je vais le réadapter.

J'ai 5 colonnes.

Mais j'ai vu qu'il y avait des problèmes de doublons, alors serait-il possible de les supprimer et de recommencer le code en boucle jusqu'à ce qu'il n'y en ait plus ( que le code trouve une autre question qui n'est pas été prise?

Le code est le même pour chaque colonne à par le nombre de questions à tirer.

Sub questcolonne1(w() As String) 

Dim v As Byte, c As New Collection, x As Integer, y() As Variant, z() As Variant, i As Byte 

Randomize 
y = Array(16, 17, 18) 
z = Array(9, 25, 42) 
For i = 0 To 2 
    Do While c.Count < 4 
        cpt% = cpt% + 1 
        If cpt% > MAX_ITER Then 
          cpt% = 0 
          Exit Do 
        End If 
        x = Int(y(i) * Rnd + z(i)) 
        If Cells(x, 3) = 1 And Cells(x, 3).Interior.ColorIndex <> 3 Then 
            On Error Resume Next 
            c.Add Cells(x, 3).Address, CStr(Cells(x, 3).Address) 
            If Err = 0 Then 
                On Error GoTo 0 
                w(v) = Cells(x, 2).Value 
                v = v + 1 
            End If 
            On Error GoTo 0 
        End If 
    Loop 
    Set c = Nothing 
Next i 

End Sub 

Sub colonne1_1() 

Dim p As Range, v As Byte, w(12) As String 

questcolonne1 w 

For Each p In Sheets("noms").Range("B4:B18") 
    If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then 
       p.Value = w(0) 
       For v = 1 To UBound(w) 
           p.Value = p.Value & "/" & w(v) 
       Next v 
    End If 
Next p 

questcolonne1 w 

For Each p In Sheets("noms").Range("B19:B34") 
    If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then 
       p.Value = w(0) 
       For v = 1 To UBound(w) 
           p.Value = p.Value & "/" & w(v) 
       Next v 
    End If 
Next p 

End Sub