Bonjour, j'ai un code qui prend 12 personnes pour un planning
comment le changer pour qu'il prenne le nombre maximum de personnes disponibles(sauf celles qui sont en rouges et ne prendre que celles qui contiennet des 1).
il faudrait ensuite que lorsqu'on met ces personnes dans le planning, les agents de la colonne précédente ne soient pas repris dans la suivante.
merci
comment le changer pour qu'il prenne le nombre maximum de personnes disponibles(sauf celles qui sont en rouges et ne prendre que celles qui contiennet des 1).
il faudrait ensuite que lorsqu'on met ces personnes dans le planning, les agents de la colonne précédente ne soient pas repris dans la suivante.
merci
Code:
Dim Idx As Byte, V As Integer, x As Integer
Dim Tableau()
Dim PtTabl As Integer
Dim w()
Sub RemplirPlanning1()
Dim y(), z()
Dim F As Integer
Sheets("Mois en cours").Range("F4:L34").ClearContents
y = Array(24, 41, 59)
z = Array(9, 25, 42)
For F = 3 To 9
ReDim w(12)
Nom_FIP_3 F, y(), z()
RemplirColonne 4, 18, F + 3
ReDim w(12)
Nom_FIP_3 F, y(), z()
RemplirColonne 19, 34, F + 3
Next F
End Sub
Sub Nom_FIP_3(Col As Integer, y(), x())
'Remet le pointeur à zéro pour commencer une nouvelle série.
PtTabl = 0
Randomize Timer 'pour avoir un tirage pseudo aléatoire.
'Précise avec quelle feuille il faut travailler.
With Sheets("Compétences")
'Boucle sur les 3 séries de lignes
For Idx = 0 To 2
'Vide le tableau Tableau()
V = -1: ReDim Tableau(20) 'si suffisant
'Mémorise TOUT les noms qui correspondent aux 2 critères.
For i = x(Idx) To y(Idx)
If .Cells(i, Col) = 1 And .Cells(i, Col).Interior.ColorIndex <> 3 Then
V = V + 1
Tableau(V) = .Cells(i, 2)
'Debug.Print Tableau(V)
End If
Next i
Reco:
'Elimine des noms de façon aléatoire jusqu'a qu'il n'en reste plus que 4
If V > 3 Then
V = V - 1
For i = Int(V * Rnd) To V
Tableau(i) = Tableau(i + 1)
'Debug.Print Tableau(i)
Next i
GoTo Reco
End If
'Rentre les 3 séries de noms l'ue après l'autre
'If V < 3 Then Stop
For i = 0 To 3
w(PtTabl) = Tableau(i)
'Debug.Print w(PtTabl)
PtTabl = PtTabl + 1
Next i
Next Idx
End With
'Pour que tu puisse contrôler dans la fenêtre d'exécution
'Ces lignes sont à supprimés quand fini.
For i = 0 To 11 'les 12 noms tirer au hazard.
Debug.Print w(i)
Next i
End Sub
Sub RemplirColonne(LigDeb As Long, LigFin As Long, Col As Integer)
Dim i As Long, V As Byte, Lg As String
For V = 0 To UBound(w)
If w(V) <> "" Then Lg = Lg & "/" & w(V)
Next V
With Sheets("Mois en cours")
For i = LigDeb To LigFin
If Cells(i, Col).Interior.ColorIndex <> 6 And Cells(i, Col) = "" Then
Cells(i, Col) = Lg
End If
Next i
End With
End Sub