Exercice planification avec le solveur

edisonalva · 2 Novembre 2017

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

edisonalva · 4 Novembre 2017

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!

job75 · 4 Novembre 2017

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+

ODVJ · 5 Novembre 2017

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 · 5 Novembre 2017

Bonjour ODVJ, le forum,

ODVJ à dit:
Sur les 4^7 combinaisons possibles, il n’en reste que 252

Je ne comprends pas, il y a beaucoup plus de combinaisons possibles.

Même en ne testant pas les valeurs en J2:K13 je ne trouve pas de solution.

En passant je viens de modifier la macro pour aller plus vite.

Bonne journée.

job75 · 5 Novembre 2017

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+

zebanx · 5 Novembre 2017

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 · 6 Novembre 2017

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+

job75 · 6 Novembre 2017

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+

job75 · 7 Novembre 2017

Bonjour le forum,

Dans le fichier précédent j'évite le tri supplémentaire pour traiter la colonne 7 (dimanche).

Bonne journée.

job75 · 7 Novembre 2017

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+

job75 · 7 Novembre 2017

Re,

Fichier (5 bis) pour peaufiner, avec des formats personnalisés et une MFC.

A+

zebanx · 7 Novembre 2017

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 · 7 Novembre 2017

Bonjour zebanx,

zebanx à dit:
Cela fait trois jours que tu codes

Oui j'ai eu du mal à trouver la bonne méthode.

Merci d'avoir suivi si attentivement.

A+

job75 · 8 Novembre 2017

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+

Exercice planification avec le solveur

edisonalva

XLDnaute Nouveau

Pièces jointes

edisonalva

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

ODVJ

XLDnaute Impliqué

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

zebanx

XLDnaute Accro

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

zebanx

XLDnaute Accro

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Exercice planification avec le solveur

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

Privacy & Transparency

Privacy & Transparency