Moulinette Dispatching
Bonjour,
La somme des contraintes peut conduire dans environ 1 cas sur 10 à une impossibilité => refaire le tirage dans ce cas !
L'attribution des rôles (ex : chef d'équipe) doit se faire dans l'ordre indiqué (ex : pour chef d'équipe = après Préventeur, PNR et Poids Lourds)
edit : fichier supprimé au profit du suivant
Un poil de modification et quelques explications ...
ok encore une fois super boulot
je vais garder les differents tableaux, si y a du changement de personnel et qu'on perd certaine compétences il faudra refaire le tableau en fonction?
encore merci pour cette aide
On peut toujours le faire tourner comme cela même en perdant des compétences ou en en regagnant de nouvelles.
Il faut bien sûr vérifier que le nombre de compétences disponibles est suffisant !
Après on risque d'aller de plus en plus vers des impossibilités; ici après test, cela donne un résultat sans erreur 9 fois sur 10 environ.
Dans le cas d'impossibilités de plus en plus fréquentes, alors oui il faut reprendre la logique, c'est-à-dire d'abord traiter les cas de compétences les plus critiques (comme ici, ce n'est pas le chef d'équipe qui peut poser problème en priorité donc on le traite après d'autres compétences plus critiques).
On pourrait réfléchir à un développement plus conséquent par VBA, mais cela risque de prendre un certain temps pour pas que ce soit une usine à gaz (cela devient de l'IA) ... j'y réfléchirai à l'occasion, !
ok merci le travail que vous avez est extra,
concernant le vba c'est pas forcement necessaire.
encore merci bonne journée
sauf pour me décrasser les neurones le matin de bonne heure !concernant le vba c'est pas forcement necessaire.
et puis je me dis que maintenant que j'ai la logique en tête, cela peut être plus "facile" que je ne le pensais ... on verra si j'y arrive d'ici une semaine !
OK si sa vous fait plaisir alors
Courage
Merci
Je poursuis doucement le projet ... pour le moment, j'ai mis les bases du VBA en place : tri quicksort de tableaux à 2 dimensions et tri aléatoire en VBA d'une liste, plus mise en place du critère de criticité pour traiter dans l'ordre les compétences.
A suivre ...
Wahoo
Je comprends pas tout mais comprendrais sûrement mieux avec les fichiers quand vous aurez fini. Encore merci
Bonne journée
Bon il n'a pas fallu une semainesauf pour me décrasser les neurones le matin de bonne heure !concernant le vba c'est pas forcement necessaire.
et puis je me dis que maintenant que j'ai la logique en tête, cela peut être plus "facile" que je ne le pensais ... on verra si j'y arrive d'ici une semaine !
Mais j'avoue que la version sans macro a été moins laborieuse !! Pour un décrassage des neurones, c'en fut un !
Et parmi les plus belles formules, il y a celle-ci :
UCase(Split(competences(Tequipes(nAgents, iEquipe)), "|")(TcriticiteInv(iCompetence, 4) - 1))L'avantage dans cette version avec macro, c'est que l'ordre de traitement va s'adapter aux ressources les plus critiques, ce qui n'est pas le cas avec la version sans macro !
Sub repartir()
Dim Tcriticite() As Variant, TcriticiteInv() As Variant
Dim Tequipes() As Variant, Teffectif() As Variant, Temp() As Variant
'ReDim Tequipes(1 To [nAgents].Value, 1 To [NEquipes].Value)
ReDim Tequipes(1 To [nAgents].Value / [NEquipes].Value, 1 To [NEquipes].Value) ' en espérant qu'il y ait un multiple
ReDim Teffectif(1 To [NEquipes].Value)
ReDim Temp(1 To [nAgents].Value)
Dim iTemp As Integer
Dim affecte As Object
Set affecte = CreateObject("Scripting.Dictionary")
Dim competences As Object
Set competences = CreateObject("Scripting.Dictionary")
' #### CRITICITE
' on capte les données
Tcriticite = Range("criticite[[#All],[chef d''équipe]:[Extincteur]]").Value
NbDeColonnes = NbCol(Tcriticite)
' inversion colonnes > lignes
ReDim TcriticiteInv(1 To NbDeColonnes, 1 To UBound(Tcriticite))
For col = 1 To NbCol(Tcriticite)
For lig = LBound(Tcriticite) To UBound(Tcriticite)
TcriticiteInv(col, lig) = Tcriticite(lig, col)
Next
Next
' tri sur le critère de criticité
Tri_2_Dim TcriticiteInv, 3
' de 1 à 6
' colonne 1 = compétence
' colonne 2 = nombre par équipe
' colonne 3 = criticité
' colonne 4 = où aller chercher dans le tableau agents
' colonne 5 = besoin
If TcriticiteInv(1, 3) < 1 Then
MsgBox "Il semble que le nombre de """ & TcriticiteInv(1, 1) & """ n'est pas suffisant !"
Exit Sub
End If
' #### CONSTITUTION EQUIPES
' initialisation à 0
For i = 1 To [NEquipes].Value
Teffectif(i) = 0
Next
For Each cel In Range("agents[AGENTS]")
affecte(cel.Value) = False
For i = 1 To 6
competences(cel.Value) = competences(cel.Value) & "|" & cel.Offset(0, i)
Next
log cel.Value & " " & competences(cel.Value)
Next
' pour chaque compétence dans l'ordre de criticité
For iCompetence = 1 To 6
log "####" & " - " & TcriticiteInv(iCompetence, 1)
' recherche du disponible
iTemp = 0
For Each cel In Range("agents[AGENTS]")
If UCase(cel.Offset(0, TcriticiteInv(iCompetence, 4) - 1).Value) = "X" And affecte(cel.Value) = False Then
iTemp = iTemp + 1
Temp(iTemp) = cel.Value
End If
Next
If iTemp = 0 Then
MsgBox "Il n'y a pas assez de ressources """ & TcriticiteInv(iCompetence, 1) & """, relancer !"
Exit Sub
End If
' tri aléatoire
TriAleatoirePartiel Temp, iTemp
For iAgent = 1 To iTemp
log "dispo " & iAgent & " " & Temp(iAgent)
Next
iAgent = 1
' répartition
For iEquipe = 1 To [NEquipes].Value
'log "effectif " & iEquipe & " (avant) " & Teffectif(iEquipe)
nOK = 0
For nAgents = 1 To Teffectif(iEquipe)
If Tequipes(nAgents, iEquipe) <> "" Then
If UCase(Split(competences(Tequipes(nAgents, iEquipe)), "|")(TcriticiteInv(iCompetence, 4) - 1)) = "X" Then
nOK = nOK + 1
log "Equipe " & iEquipe & " |" & Tequipes(nAgents, iEquipe) & "| <<<>>> |" & competences(Tequipes(nAgents, iEquipe)) & "|"
End If
End If
Next
log TcriticiteInv(iCompetence, 1) & " " & nOK & " déjà affectés en équipe " & iEquipe & " pour un besoin de " & TcriticiteInv(iCompetence, 5)
If nOK < TcriticiteInv(iCompetence, 5) Then
For nAgents = 1 To TcriticiteInv(iCompetence, 5) - nOK
Teffectif(iEquipe) = Teffectif(iEquipe) + 1
Tequipes(Teffectif(iEquipe), iEquipe) = Temp(iAgent)
affecte(Temp(iAgent)) = True
log "++++++++++++" & Temp(iAgent) & " "
iAgent = iAgent + 1
Next
End If
'log "effectif " & iEquipe & " (après) " & Teffectif(iEquipe)
Next
Next
' compléments
iTemp = 0
For Each cel In Range("agents[AGENTS]")
If affecte(cel.Value) = False Then
iTemp = iTemp + 1
Temp(iTemp) = cel.Value
End If
Next
' tri aléatoire
TriAleatoirePartiel Temp, iTemp
iAgent = 1
For iEquipe = 1 To [NEquipes].Value
If Teffectif(iEquipe) < 6 Then
For nAgents = 1 To 6 - Teffectif(iEquipe)
Teffectif(iEquipe) = Teffectif(iEquipe) + 1
Tequipes(Teffectif(iEquipe), iEquipe) = Temp(iAgent)
affecte(Temp(iAgent)) = True
log "++++++++++++" & Temp(iAgent) & " "
iAgent = iAgent + 1
Next
End If
Next
Range("resultat") = Application.WorksheetFunction.Transpose(Tequipes)
End Sub
Function NbCol(Tableau As Variant) As Integer
' de 1 à NbCol
Dim col As Integer
On Error GoTo Fin
Do: col = col + 1: contenu = Tableau(1, col): Loop
Fin:
NbCol = col - 1
End Function
Sub Tri_2_Dim(ByRef Tableau As Variant, _
Optional Colonne As Long = 1, _
Optional mini As Long = -1, _
Optional maxi As Long = -1)
Dim i As Long, j As Long, Pivot As Variant, TableauTemp As Variant, ColTemp As Long
If mini = -1 Then mini = LBound(Tableau)
If maxi = -1 Then maxi = UBound(Tableau)
On Error Resume Next
i = mini: j = maxi
Pivot = Tableau((mini + maxi) \ 2, Colonne)
While i <= j
While Tableau(i, Colonne) < Pivot And i < maxi: i = i + 1: Wend
While Pivot < Tableau(j, Colonne) And j > mini: j = j - 1: Wend
If i <= j Then
ReDim TableauTemp(LBound(Tableau, 2) To UBound(Tableau, 2))
For ColTemp = LBound(Tableau, 2) To UBound(Tableau, 2)
TableauTemp(ColTemp) = Tableau(i, ColTemp)
Tableau(i, ColTemp) = Tableau(j, ColTemp)
Tableau(j, ColTemp) = TableauTemp(ColTemp)
Next ColTemp
Erase TableauTemp
i = i + 1: j = j - 1
End If
Wend
If (mini < j) Then Call Tri_2_Dim(Tableau, Colonne, mini, j)
If (i < maxi) Then Call Tri_2_Dim(Tableau, Colonne, i, maxi)
End Sub
Sub TriAleatoirePartiel(ByRef Tableau As Variant, N As Integer)
Dim TableauTemp() As Variant
ReDim TableauTemp(1 To UBound(Tableau))
rang = Split(IndicesAleatoiresSansDoublons(N), "|")
For i = LBound(rang) To UBound(rang)
TableauTemp(i + 1) = Tableau(rang(i))
Next
Tableau = TableauTemp
End Sub
Function IndicesAleatoiresSansDoublons(NbValeurs As Integer)
' de 1 à NbValeurs
Dim Tableau() As Integer, TabNumLignes() As Integer
Dim i As Integer, k As Integer
ReDim Tableau(NbValeurs)
ReDim TabNumLignes(NbValeurs)
For i = 1 To NbValeurs
TabNumLignes(i) = i
Tableau(i) = i
Next
'Initialise le générateur de nombres aléatoires
Randomize
IndicesAleatoiresSansDoublons = ""
For i = NbValeurs To 1 Step -1
k = Int((i * Rnd)) + 1
IndicesAleatoiresSansDoublons = IndicesAleatoiresSansDoublons & "|" & Tableau(TabNumLignes(k))
TabNumLignes(k) = TabNumLignes(i)
Next
IndicesAleatoiresSansDoublons = Right(IndicesAleatoiresSansDoublons, Len(IndicesAleatoiresSansDoublons) - 1)
log "tri : " & IndicesAleatoiresSansDoublons
End Functionsuper boulot bravo. merci
je regarderai de plus près pour essayer de mieux comprendre le fonctionnement
mais sa marche nickel
merci
Prends de l'aspirine, même moi j'ai du mal à m'y retrouver !!je regarderai de plus près pour essayer de mieux comprendre le fonctionnement
OK merci
En tous cas si tu veux encore te décrasser les méninges j'ai plein d'autres projet et idées. Mais j'attends de voir se qui vont mettre en place l'année prochaine.
Encore merci il va me falloir quelques années avant que j'en arrive là. Lol
Prends de l'aspirine, même moi j'ai du mal à m'y retrouver !!je regarderai de plus près pour essayer de mieux comprendre le fonctionnement
bonjour
je viens de voir que l'on peut changer le nombre d'équipe ? ou c'est une cellule a ne pas modifier ?
sa serai pas possible de pouvoir basculer sur 6 equipe de 5 par exemple ?
merci
Oui et non, j'ai en effet écrit le programme dans un objectif de paramétrage, mais il reste quand même parfois une certaine rigidité.
Je vais regarder pour finaliser ce point et faire quelques tests !
Voici ... essaie le 5x6, le 6x5, voire le 4x7 ou 7x4 en supprimant 2 agents ... mais ajuste les contraintes sinon ce sera impossible (ex : 6 équipes avec 5 PNR !)
pardon pour cette réponse tardive
j'ai tester ton nouveau fichier, encore une fois jolie travail
a plusieur reprise il me mets qu'il manque PNR ou Poids Lourds alors que le ratio est bon.
peux t'on faire une relance automatique avant d'avoir ce message ? (3 ou 4 relance puis message )
et autre chose j'ai un bouton qui exécute plusieurs macro, est il possible de stopper toutes les macros si on a un message box
merci
Bonsoir,
a plusieur reprise il me mets qu'il manque PNR ou Poids Lourds alors que le ratio est bon.
ce n'est pas exclu, je l'avais mentionné
le tirage au sort a pu "prélever" des ressources rares ! mais je n'ai pas voulu alambiquer le code davantage sachant qu'on peut refaire un tirage
peux t'on faire une relance automatique avant d'avoir ce message ? (3 ou 4 relance puis message )
ok je regarde ce point
et autre chose j'ai un bouton qui exécute plusieurs macro, est il possible de stopper toutes les macros si on a un message box
les macros sont séquentielles, il n'y a pas ici de parallélisation des macros
donc on peut toujours mettre un exit sub après un msgbox
Hé bien non, j'ai revu la macro, le message ne s'affiche que si le nombre de compétences est insuffisant pour couvrir toutes les équipes avec le nombre mini.
j'ai trouver mon erreur
je demandé 4 équipier, pour sa que sa fesait une erreur. il priorisé les equipiés donc plus de places pour les PNR ou autre. donc je laisse les équipier a zero et c'est ok