concernant le vba c'est pas forcement necessaire.
sauf pour me décrasser les neurones le matin de bonne heure !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 !
Bon il n'a pas fallu 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 Function