Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Exercice planification avec le solveur

edisonalva

XLDnaute Nouveau
Bonjour à tous,

Je cherche à déterminer pour un exercice à l’aide du solveur pour les employés d’un service les jours pendant lesquels ils seront au repos sur une semaine.
Les repos sont affectés sur des périodes de deux jours consécutifs uniquement (pas de repos isolés)

Mes contraintes :
- Couverture exacte du besoin RH
- Changement de vacation de type ordonné : Enchaînements interdits: Soir-Matin, Nuit-Soir, Nuit-Matin

Mes contraintes flexibles:
- Interdiction d’affecter un repos isolé
- Répartition équitable des repos

Je n'arrive pas à trouver la solution pour faire interdire les enchaînement. Comment faire pour mettre le minimum de contrainte dans le Solveur? Pouvez vouz m'aidez SVP? Merci d'avance
 

Pièces jointes

  • excercice medecin.xlsx
    19.4 KB · Affichages: 74

edisonalva

XLDnaute Nouveau
Pour faire plus simple je n'ai pas un nombre d'employé prédéfinit par jour il faut juste que les repos soivent sur Deux jours concecutifs et que mes besoins en ressources humaines correspondes à ceci :
  • vacation Lun Mar Mer Jeu Ven Sam Dim
  • Matin 5 5 4 5 6 5 7
  • Soir 1 1 2 2 2 3 1
  • Nuit 1 1 1 1 1 1 1


J'ai simplié mon fichier excel pour une meilleur conpréhention. Merci de votre aide!
 

Pièces jointes

  • Classeur1.xlsx
    12.4 KB · Affichages: 66

job75

XLDnaute Barbatruc
Bonsoir edisonalva,

Je ne vois pas comment on peut utiliser le Solver puisque les valeurs sont discontinues sur B2:H13.

J'ai essayé avec 100 000 tirages aléatoires pour vos 2 hypothèses (posts #1 et #2) :
Code:
Sub Tirages()
Dim Ntirages&, cible As Range, n&
Ntirages = 100000 'nombre de tirages, modifiable
Set cible = [O1]
Application.ScreenUpdating = False
With [B2:H13]
  .Formula = "=RANDBETWEEN(0,3)" 'ALEA.ENTRE.BORNES
  For n = 1 To Ntirages
    If cible = True Then Exit For
    Calculate 'nouveau tirage
  Next
  .Value = .Value 'supprime les formules
  Feuil3.Range(.Address) = "=VLOOKUP(Feuil2!B2,Feuil2!$J$17:$K$20,2,0)"
  Feuil3.Range(.Address) = Feuil3.Range(.Address).Value 'supprime les formules
End With
End Sub

Dans les 2 cas on ne trouve pas de solution, il y a trop de combinaisons possibles.

Fichiers joints.

A+
 

Pièces jointes

  • excercice medecin(1).xlsm
    31.6 KB · Affichages: 50
  • excercice medecin(1 bis).xlsm
    31.5 KB · Affichages: 51
Dernière édition:

ODVJ

XLDnaute Impliqué
Bonsoir job75,

Sur les 4^7 combinaisons possibles, il n’en reste que 252 lorsque tu appliques les contraintes d’enchaînements et de repos contigus.
Ça peut rendre ton approche efficace.

Cordialement
 

job75

XLDnaute Barbatruc
Re,

Bon maintenant je remplis les colonnes B à H une par une :
Code:
Sub Tirages()
Dim Ntirages&, cible As Range, col%, n&
Ntirages = 10000 'nombre de tirages, modifiable
Set cible = [O1]
Application.ScreenUpdating = False
With [B2:H13]
  .Value = "" 'RAZ
  For col = 1 To 7
    .Columns(col) = "=RANDBETWEEN(0,3)" 'ALEA.ENTRE.BORNES
    For n = 1 To Ntirages
      If cible = True Then .Columns(col) = .Columns(col).Value: Exit For
      Calculate 'nouveau tirage
  Next n, col
  .Value = .Value 'supprime les formules s'il en reste
  Feuil3.Range(.Address) = "=VLOOKUP(Feuil2!B2,Feuil2!$J$17:$K$20,2,0)"
  Feuil3.Range(.Address) = Feuil3.Range(.Address).Value 'supprime les formules
End With
End Sub
Les formules des tests ont été revues.

Le fichier (2) ne passe pas mais avec le fichier (2 bis) - sans la colonne J - ça passe.

A+
 

Pièces jointes

  • excercice medecin(2).xlsm
    31.7 KB · Affichages: 55
  • excercice medecin(2 bis).xlsm
    31.7 KB · Affichages: 56
Dernière édition:

zebanx

XLDnaute Accro
Bonjour Job75 (et le forum)
Il y a déjà un code épuré après la mise en place des formules qui suprend par une taille si réduite.
Mais sur le principe, la prise en compte de ce type de contraintes avec une rotation automatique... bref la logique pour arriver à un tel résultat.
G-E-N-I-A-L.
 

job75

XLDnaute Barbatruc
Bonjour le forum,

Une solution très différente et plus intéressante dans la mesure où la demande RH du dimanche (9 vacations) n'est pas inférieure à celle du samedi :
Code:
Sub Tirages()
Dim col%, matin, soir, nuit, n&, c As Range
Application.ScreenUpdating = False
With [B2:H13]
  .Value = 0 'RAZ
  .Columns(1).EntireColumn.Insert
  For col = 1 To 7
    matin = .Cells(17, col): soir = .Cells(18, col): nuit = .Cells(19, col) 'à adapter
    If col = 7 Then .Columns(1).Resize(, 6).Sort .Columns(6), xlDescending, Header:=xlNo
    n = 0
    For Each c In .Columns(col).Cells
      If Not (CStr(c(1, 0)) = "0" And CStr(c(1, -1)) <> "0") Then
        n = n + 1
        c = IIf(n <= matin, 1, IIf(n <= matin + soir, 2, IIf(n <= matin + soir + nuit, 3, 0)))
      End If
    Next c
    .Columns(1).Resize(, 9).Sort .Columns(9), Header:=xlNo 'tri aléatoire
  Next col
  .Columns(0).EntireColumn.Delete
  Feuil3.Range(.Address) = "=VLOOKUP(Feuil2!B2,Feuil2!$J$17:$K$20,2,0)"
  Feuil3.Range(.Address) = Feuil3.Range(.Address).Value 'supprime les formules
End With
End Sub
Fichier (3).

On minimisera l'écart-type en faisant plusieurs tirages successifs.

A+
 

Pièces jointes

  • excercice medecin(3).xlsm
    33.6 KB · Affichages: 54

job75

XLDnaute Barbatruc
Re,

Ceci est mieux, la fonction ALEA() est entrée dans la colonne insérée :
Code:
Sub Tirages()
Dim col%, matin, soir, nuit, n&, c As Range
Application.ScreenUpdating = False
With [B2:H13]
  .Value = 0 'RAZ
  .Columns(1).EntireColumn.Insert
  .Columns(0) = "=RAND()" 'ALEA()
  For col = 1 To 7
    matin = .Cells(17, col): soir = .Cells(18, col): nuit = .Cells(19, col) 'à adapter
    n = 0
    For Each c In .Columns(col).Cells
      If c(1, 0) <> 0 Or IIf(col < 7, c(1, -1) = 0, False) Then
        n = n + 1
        c = IIf(n <= matin, 1, IIf(n <= matin + soir, 2, IIf(n <= matin + soir + nuit, 3, 0)))
      End If
    Next c
    .Columns(0).Resize(, 8).Sort .Columns(0), Header:=xlNo 'tri aléatoire
  Next col
  .Columns(0).EntireColumn.Delete
  Feuil3.Range(.Address) = "=VLOOKUP(Feuil2!B2,Feuil2!$J$17:$K$20,2,0)"
  Feuil3.Range(.Address) = Feuil3.Range(.Address).Value 'supprime les formules
End With
End Sub
Fichier (4).

A+
 

Pièces jointes

  • excercice medecin(4).xlsm
    33.3 KB · Affichages: 50
Dernière édition:

job75

XLDnaute Barbatruc
Re,

Avec la solution précédente je traite maintenant les changements interdits.

Le changement interdit SOIR-MATIN (2+1) ne passe pas, les autres passent :
Code:
Sub Tirages()
Dim Ntirages&, col%, matin, soir, nuit, n&, c As Range, b As Byte, tirage&
Application.ScreenUpdating = False
Ntirages = 1000 'modifiable
With [B2:H13]
  .Columns(1).EntireColumn.Insert
  .Columns(0) = "=RAND()" 'ALEA()
  For col = 1 To 7
    .Columns(col) = 0 'RAZ
    matin = .Cells(17, col): soir = .Cells(18, col): nuit = .Cells(19, col) 'à adapter
    n = 0
    For Each c In .Columns(col).Cells
      If c(1, 0) <> 0 Or IIf(col < 7, c(1, -1) = 0, False) Then
        n = n + 1
        b = IIf(n <= matin, 1, IIf(n <= matin + soir, 2, IIf(n <= matin + soir + nuit, 3, 0)))
        If c(1, 0) & b = "31" Or c(1, 0) & b = "32" Then col = col - 1: tirage = tirage + 1: Exit For
        c = b
      End If
    Next c
    If tirage = Ntirages Then .Value = "": MsgBox " Recommencez...": Exit For
    .Columns(0).Resize(, col + 1).Sort .Columns(0), Header:=xlNo 'tri aléatoire
  Next col
  .Columns(0).EntireColumn.Delete
  Feuil3.Range(.Address) = "=VLOOKUP(Feuil2!B2,Feuil2!$J$17:$K$20,2,0)"
  Feuil3.Range(.Address) = Feuil3.Range(.Address).Value 'supprime les formules
End With
End Sub
Fichier (5).

A+
 

Pièces jointes

  • excercice medecin(5).xlsm
    34.2 KB · Affichages: 52

zebanx

XLDnaute Accro
Bonjour Job75

Tu es le seul à t'être collé à la demande et avec encore une fois un acharnement (bien connu) à le rendre meilleur sur plusieurs versions.
Il resservira ou donnera quelques idées en tout cas sur d'autres demandes de ce type (plages plus longues par exemple) qui relèvent d'un haut niveau (logique et traduction code).
Cela fait trois jours que tu codes, pas de réponse, c'est étonnant (sinon) par rapport à une telle demande qui relève largement plus du sur-mesure que du prêt-à-porter. Cette proposition remarquable n'a échappée à personne en tout cas, notamment vu l'affluence ( >200 viewers) du dit-fil.

++
 

job75

XLDnaute Barbatruc
Bonjour le forum,

Avec la macro Tirages précédente il n'est pas facile d'obtenir l'écart-type minimum 0,492.

Cette solution permet de l'obtenir rapidement, il suffit de mettre la cellule N1 sur 0,5 :
Code:
Dim boucle As Boolean 'mémorise la variable

Sub Arret() 'bouton de sécurité
boucle = False
End Sub

Sub Tirages()
Dim cible As Range, etm#, Ntirages&, tirage&, col%, matin, soir, nuit, n&, c As Range, b As Byte, a
Application.ScreenUpdating = False
boucle = True
Set cible = [L1] 'à adapter
etm = [N1] 'à adapter, écart-type maximum
Ntirages = 100 'modifiable
With [B2:H13] 'à adapter
  .Columns(1).EntireColumn.Insert
  .Columns(0) = "=RAND()" 'ALEA()
  Do
    DoEvents 'permet le clic sur le bouton Arrêt
    tirage = 0
    For col = 1 To 7
      .Columns(col) = 0 'RAZ
      matin = .Cells(17, col): soir = .Cells(18, col): nuit = .Cells(19, col) 'lignes à adapter
      n = 0
      For Each c In .Columns(col).Cells
        If c(1, 0) <> 0 Or IIf(col < 7, c(1, -1) = 0, False) Then
          n = n + 1
          b = IIf(n <= matin, 1, IIf(n <= matin + soir, 2, IIf(n <= matin + soir + nuit, 3, 0)))
          If c(1, 0) & b = "31" Or c(1, 0) & b = "32" Then col = col - 1: tirage = tirage + 1: Exit For
          c = b
        End If
      Next c
      If tirage = Ntirages Then
        If Not boucle Then .Value = "": .Columns(0).EntireColumn.Delete: MsgBox " Recommencez...": Exit Sub
        Exit For
      End If
      .Columns(0).Resize(, col + 1).Sort .Columns(0), Header:=xlNo 'tri aléatoire
    Next col
  Loop While boucle And cible > etm Or tirage = Ntirages 'recherche des écarts-types < etm
  .Columns(0).EntireColumn.Delete
  '---formats personnalisés---
  a = Array("""repos""", """matin""", """soir""", """nuit""")
  For n = 0 To 3
    .Replace n, ""
    With .SpecialCells(xlCellTypeBlanks): .NumberFormat = "[=" & n & "]" & a(n): .Value = n: End With
  Next n
End With
End Sub
Fichier (6).

A+
 

Pièces jointes

  • excercice medecln(6).xlsm
    30.2 KB · Affichages: 60
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…