Tirage aléatoire sans remise d'agents

Bonjour,

Je fais un planning de gestion des agents.

Mon programme prend de la feuille "compétences", les agents dont la cellule n'est pas rouge et dont la cellule comprend des 1.

Il les met ensuite dans un planning de la feuille "mois en cours", mais pas dans les cellules jaunes.

Tout marche bien jusque là mais les noms des agents se répètent d'une colonne à l'autre.

Je voudrais qu'un nom ne se mette que dans une cellule d'une ligne car en ligne se trouve les jours et en colonne leurs activités.

Un agent ne peut faire qu'une activité par jour. Il faudrait donc je suppose modifier mon code en tirage sans remise.

Exemple

pas bon:

F4: toto titi tata

G4: toto tutu tyty

bon:

F4: toto titi tata

H4: tutu tete tyty

Et cela jusqu'en ligne 34 et colonne L.

Merci de m'aider.

Sub Nom_FIP_1(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 FIP_AIP_MUSC_1()

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

Nom_FIP_1 w

For Each p In Sheets("Mois en cours").Range("F4:F18")
    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

Nom_FIP_1 w

For Each p In Sheets("Mois en cours").Range("F19:F34")
    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

salut

sans fichier joint, j'ai du mal à me représenter vraiment la chose, mais :

il me semble qu'en ajoutant un booléen lié à chaque variable "agent" que l'on met sur false quand on insert un agent à une place, ça doit jouer si avant d'insérer l'agent, on contrôle que le booléen soit sur true.

Voilà mon fichier

https://www.excel-pratique.com/~files/doc2/classeur1_pmo.zip