Planning tour de role ménage

Bonjour la communauté,

J'ai cherche un peu les sujet en lien mais je ne trouve pas tout a fait ce que je recherche, j'ai donc un problème a vous soumettre.

Je code usuellement sur LISP (AutoCAD) mais je tente de me lancer en VBA sur Excel (également AutoCAD). J'ai quelques petites bases mais je ne connais/comprends pas la façon de structurer les programmes (Modules, formulaires...).

Bref, je désire réaliser un programme (ou une macro de préférence) de tour de role de ménage avec ces conditions :

  • 1 ménage tous les jours de la saison sauf le samedi (fonction Serie Jour Ouvré ?) ;
  • Un nombre de ménage par personne qui peut varier entre 1 et 4 ;
  • Une distribution de ménage aléatoire mais non groupé (pas de ménage pour la meme personne deux jours d'affilé);

L'objectif est donc, à partir d'une liste de personne (environ 20) a qui un nombre de ménage est attribué, remplir un calendrier avec les nom des personnes, excepté le samedi, en cliquant sur un bouton macro de préférence (de façon a ce que si je change le nombre de ménage je puisse facilement reremplir le calendrier).

Voila, j'espere que c'est assez claire. S'il faut je peux joindre un fichier exemple et le debut de macro..

Merci d'avance.

Nicky

Bonjour,

Je joins un fichier exemple avec une feuille "nom" contenant les nom des personnes et leur nombre de ménage respectif et une feuille "calendrier" ou leur nom doit apparaitre en fonction du nombre de ménage qu'ils doivent réaliser..

Merci d'avance,

bonjour,

ce n'est qu'un début

Sub aleatoire()
     Dim Débit, Fin, Arr, Result, Pauze
     Pauze = 5     '5 jours après tache

     t = Timer     'chrometre
     début = DateSerial(2022, 12, 1)
     Fin = DateSerial(2023, 4, 30)
     ReDim Result(1 To Fin - début + 1, 1 To 2)     'preparer l'array RESULTAT
     Arr = Sheets("Nom").Range("A4:B25")     'lire les données des monteurs
     ReDim Preserve Arr(1 To UBound(Arr), 1 To 3)     'ajouter une colonne supplementaire a cet array

     For i = 1 To UBound(Result)     'boucle les jours
          Result(i, 1) = début + i - 1     'jour
          If WorksheetFunction.Weekday(Result(i, 1), 2) <> 6 Then     'ce n'est pas un samedi
               seq = Evaluate("=column(A1:zz1)")     'serie de 1 a 700 (exagéré), (=1,2,3,4,5,6, ...., 702)
               For j = UBound(Arr) To 1 Step -1     'boucle tous les monteurs
                    b = False     'drapeau
                    r = WorksheetFunction.RandBetween(1, j)     'monteur aleatoire
                    r1 = seq(r) 'numéro du monteur
                    If Arr(r1, 3) >= Arr(r1, 2) Then     'monteur a déjà fait tous ces tâches
                         seq(r) = seq(j)     'effacer ce monteur du liste pour ce jour
                    Else
                         For i1 = Application.Max(1, i - Pauze) To i - 1 'reculer tant de jours
                              If Result(i1, 2) = Arr(r1, 1) Then 'monteur a fait un tache pendant ces jours
                                   seq(r) = seq(j) 'alors un autre
                                   b = True 'drapeau
                                   Exit For
                              End If
                         Next
                         If Not b Then 'drapeau bas
                              Result(i, 2) = Arr(r1, 1)     'assigner monteur à ce jour
                              Arr(r1, 3) = Arr(r1, 3) + 1     'incremer le nombre de taches de ce monteur
                              b = True     'drapeau haut
                              Exit For     'fin du boucle
                         End If
                    End If
               Next
          End If
     Next

     Sheets("nom").Range("E1").Resize(UBound(Result), UBound(Result, 2)).Value = Result 'array resultat >>> feuille
     MsgBox "prêt en " & Format(Timer - t, "0.00\s")
End Sub

Salut BsAlv!

Merci, c'est un tres bon debut.

Je vais bosser un peu dessus pour essayer de l'arranger!

bonjour,

la description n'était pas très détaillée, donc ma réponse était qu'un essai.

Si vous n'y arriverez pas, reformuler votre question et je regarderai cela ...

Oui oui c'est vrai je n'avais pas trop détaillée mais merci de la premiere réponse c'est déjà super en tout cas, j'ai bien saisi la routine (merci pour les commentaires très explicites).

En fait je souhaiterais que les valeurs trouvées "s'ecrivent" directement dans la sheet "Calendrier" et dans les bonnes cases. Je sais qu'il suffit de récupérer la valeur des cellules dans la sheet "NOM" mais si le programme pouvait l'executer directement ca serait top..

La fonction aléatoire est superbe!

Par quel formule faudrait-il remplacer WorksheetFunction.RandBetween pour les moniteurs se suivent dans leur tache (moniteur 1, moniteur 2, moniteur 3...) ?

Merci encore.

bonjour,

la macro adaptée, les resultats s'incrivent directement dans la 2ième feuille.

Je ne comprends pas l'autre question "RandBetween", cela veut dire que les monteurs ne sont plus aleatoire ?

Salut,

Magnifique, c'est exactement ce que je voulais.

Super les ameliorations "Debut, Fin et période" !!

Oui oui, j'aimerai bien pouvoir l'utiliser en continue et puis c'est surtout pour comprendre la difference.

Merci en tout cas, le programme est parfait!

Merci

Je reviens sur ce sujet afin de savoir s'il est possible de supprimer la fonction aléatoire et que les moniteurs réalisent leurs taches toujours dans le meme ordre.

Une idée du code a modifier ? ajouter ? supprimer ?

Merci d'avance !

bonjour,

quelque chose comme ceci ???

Bonjour,

Oui, c'est exactement ca.

Merci beaucoup!

Rechercher des sujets similaires à "planning tour role menage"