Méthode WorksheetFunction.Min

Bonsoir le forum, :)

mon code distribue les permanences du samedi en fonction des disponibilités à travers un tirage aléatoire;

je veux changer le tirage pour qu'il sélectionne les employés qui ont le minimum de permanence , l'objectif c'est d'avoir l'équité entre les différents employés (l'écart entre 2 employés ne doit pas dépasser 2 permanences)

j'espère que c claire

voilà mon code :

Sub planning()
Dim tabville(6, 2)

Dim minimum As Integer

Randomize Timer
dl = Cells(Rows.Count, 1).End(xlUp).Row
For semaine = 1 To 13 '13 semaines à traiter
coldispo = semaine + 2 'numéro de colonne des dispos de la semaine
'MsgBox coldispo
colselect = coldispo + 15 '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).Value
If Cells(i, coldispo).Value = 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))

'Range("min_sam").Value = " " 'min_sam c'est le range de la somme(colonne)
'Average = Cells(i, 30).Value ' sélectionner 7 cmp qui ont le min de perm
'MinPerm = Application.min(Average)
Set plage = Worksheets("permanences samedi").Range("AF2:AF57")
minimum = Application.WorksheetFunction.min(Range("AF2:AF57"))
'MsgBox "Valeur minimale : " & minimum

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) = "1"
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

4multi-sam-1.xlsm (21.70 Ko)
Rechercher des sujets similaires à "methode worksheetfunction min"