add other constraints to my code vba

[asta22]

HELLO,

I want to add other constraints to my code,

my code distributes Saturday hotlines based on availability through a random selection;

I want to change the selection so that it respects the 1st constraint (employees who work part-time do less duty with a difference of 25% compared to the other employees) + the 2nd constraint is to have equity between the different employees) for example the employees will not do more than 3 permanences in a quarter and minimum 1 permanence (max 3 min 1)

my code :

Sub test()
    Dim tabville(6, 2)
    Randomize Timer
    dl = Cells(Rows.Count, 1).End(xlUp).Row
    For semaine = 1 To 7 '4 semaines à traiter
    coldispo = semaine + 2  'numéro de colonne des dispos de la semaine
    colselect = coldispo + 7 'numéro de colonne des personnes sélectionnées pour la semaine
    Cells(2, colselect).Resize(dl, 1).ClearContents
    Set dict = CreateObject("scripting.dictionary")
    For i = 2 To dl 'mémorise les dispo par villes
        ville = Cells(i, 1)
        If Cells(i, coldispo) = 1 Then
            dict(ville) = dict(ville) & " " & i
        End If
    Next i
    k = 0
    For Each ville In dict.keys 'sélectionner les villes avec assez de disponibilités
        numeroligne = Split(dict(ville)) 'array
        If UBound(numeroligne) >= 3 Then
            k = k + 1
            tabville(k, 1) = ville
            tabville(k, 2) = dict(ville)
        End If
    Next
    For i = 1 To k 'melange les villes candidates
        a1 = aleatoire(1, k)
        a2 = aleatoire(1, k)
       A = tabville(a1, 1): tabville(a1, 1) = tabville(a2, 1): tabville(a2, 1) = A 'on échange la position des villes du dict
       A = tabville(a1, 2): tabville(a1, 2) = tabville(a2, 2): tabville(a2, 2) = A 'on échange la position des définitions du dict
    Next i
    For i = 1 To 3 'choisir 3 villes
        numeroligne = Split(tabville(i, 2))
        For j = 1 To 2 + IIf(i = 1, 1, 0) 'choisir 3 personnes première ville et 2 personnes pour chacune des 2 autres villes
            Do
                A = aleatoire(1, UBound(numeroligne))
            Loop Until Cells(numeroligne(A), colselect) = ""
            Cells(numeroligne(A), colselect) = "W"
        Next j
    Next i
    Set dict = Nothing
    Next semaine 'semaine suivante
End Sub
Function aleatoire(borne_inférieure, borne_supérieure)
    aleatoire = Int(Rnd() * (borne_supérieure - borne_inférieure + 1)) + borne_inférieure
End Function