nombre de noms à mettre dans des cellules

[mgrizzly]

Bonjour,
Je fais un planning pour gérer les agents. J'ai une feuille "mois en cours" avec un calandrier où les weekend et jours fériés sont mis en jaune et une autre feuille "compétences", où on trouve un tableau des agents et de leurs compétences:
colonne 1: id des agents
colonne 2: nom des agents
colonne 3 juqu'à colonne 9: compétences des agents marqués avec des 1 et des 0 pour sachant faire et ne sachant pas faire.
J'ai un code qui prend aléatoirement 3 agents de la ligne 9 à 24, 3 agents de la ligne 25 à 42 et 3 agents de la ligne 43 à 59, sauf les cellules colorés en rouge (agent en congés).
Le code puisse prendces 9 agents et les met dans chaque cellules blanches de la feuille "mois en cours" de la cellule F4 à F34.

J'ai essayé de prendre 4 agents à la place de 3:
j'ai remplacé

Do While c.Count < 3

par

Do While c.Count < 4

Mais ça ne marche pas:
à

w(v) = Cells(x, 2).Value

ça me marque " l'indice n'appartient pas à la sélection".

Voici mon code :

Sub Nom_FIP_3(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
        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_3()

Dim p As Range, v As Byte, w(8) As String
 
Nom_FIP_3 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 8
           p.Value = p.Value & "/" & w(v)
       Next v
    End If
Next p
 
Nom_FIP_3 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 8
           p.Value = p.Value & "/" & w(v)
       Next v
    End If
Next p
 
End Sub

Merci de m'aider!

 

[PMO2]

Re : nombre de noms à mettre dans des cellules

Bonjour,

A tout hasard, essayez avec la Sub suivante

Sub FIP_AIP_MUSC_4()

Dim p As Range, v As Byte, w(11) As String  'modif
 
Nom_FIP_3 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) 'modif
           p.Value = p.Value & "/" & w(v)
       Next v
    End If
Next p
 
Nom_FIP_3 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) 'modif
           p.Value = p.Value & "/" & w(v)
       Next v
    End If
Next p
 
End Sub

Cordialement.

PMO
Patrick Morange

 

[mgrizzly]

Re : nombre de noms à mettre dans des cellules

OK merci PMO2 ça marche!