Répartition tâches annuelles


#1

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.

Anthony

ExempleRepartition v2.xlsx (10,1 Ko)


#2

Bonjour,

A tester

LES MACROS

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

ExempleRepartition v2.xlsm (20,5 Ko)


#3

Bonjour,

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.

Merci, merci et encore merci pour votre aide.

Au plaisir de vous lire une prochaine fois

Cordialement


#4

Re,

Ok
Si ton problème est résolu n’oublie pas de cliquer sur le petit :white_check_mark: sous la solution pour la valider.
A la prochaine


fermé automatiquement #5

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.