Bonjour à la communauté,
Je suis confronté à un problème difficile à résoudre pour moi tout seul et c’est pour çà que je fais appel à vous.
J’aimerais répartir dans un tableau de manière équitable (environ le même nombre de tâches par personnes (à 1 près) avec compteur ?) des personnes (la liste est à côté du tableau) mais j’ai quelques contraintes.
Il ne doit pas y avoir la même personne sur le même mois (même colonne) et si possible la même personne ne doit pas faire la même tâche dans l’année (même ligne). Enfin une dernière contrainte, si une cellule du tableau n’est pas vide alors il faut passer à la suivante sans rien changer à la cellule remplie.
J’espère que mes explications ont été claires. Je joins un fichier pour montrer la structure initiale de celui-ci.
Je pense que par macro cela doit être possible mais je ne sais pas par quoi commencer.
Un grand merci d’avance pour toute l’aide que vous pourrez m’apporter.
Option Explicit
'Déclaration des variables
Dim Lig%, Col%, Dl%, j%
Dim Plage As Range
Dim Cel As Range
Sub Test()
Dl = Range("O" & Rows.Count).End(xlUp).Row 'Dernière ligne des personnes
j = 2 'initialisation compteur personne
For Lig = 2 To 21 'boucle sur ligne
For Col = 2 To 13 'boucle sur colonne
If Cells(Lig, Col) = "" Then 'si la cellule est vide
DoublonCol 'se rend sur vérif doublon ligne
DoublonLig 'se rend sur vérif doublons colonne
Cells(Lig, Col) = Cells(j, 15) 'si pas de doublons, je place la personne
If j = Dl Then j = 1 'si mon compteur est égal à la derniere ligne, j'initialise le compteur à 1
j = j + 1 'ajoute 1 au compteur
End If
Next Col
Next Lig
End Sub
Sub DoublonCol()
With Worksheets("Feuil1")
Set Plage = .Range(.Cells(Lig, 2), .Cells(Lig, 13)) 'initialise la plage colonne
End With
For Each Cel In Plage 'boucle sur la plage pour compter le nb valeur de la personne à placer
If Application.CountIf(Plage, Cells(j, 15)) > 0 Then 'si la valeur est supérieur à 0
j = j + 1 ' j'ajoute 1 au compteur
End If
Next Cel
End Sub
Sub DoublonLig()
With Worksheets("Feuil1") 'idem que ci-dessus pour les lignes
Set Plage = .Range(.Cells(2, Col), .Cells(21, Col))
End With
For Each Cel In Plage
If Application.CountIf(Plage, Cells(j, 15)) > 0 Then
j = j + 1
End If
Next Cel
End Sub
Quelle rapidité !!! J’ai testé et cela fonctionne parfaitement. J’ai ajouté une formule NB.SI à coté de mes noms de la liste pour avoir leurs itérations.
sous la solution pour la valider.