prendre toute les personnes disponibles

[mgrizzly]

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

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

 

[mgrizzly]

Re : prendre toute les personnes disponibles

Voici ce que je souhaite faire:

1) Parcourir tout le tableau des agents et rechercher les agents disponibles
2) Rechercher les compétences de l'agent :
Si une seule compétence => placer l'agent pour le mois entier dans la colonne correspondante
Si plus d'une => choisir au hasard une compétence pour une quinzaine, choisir au hasard une autre compétence pour l'autre quinzaine.

De cette manière, je garantis le fait de n'avoir chaque agent que dans une seule colonne, par jour et par quizaine.