Difficulté mathématique m'empêchant de coder un algorithme

Version imprimable

24/04/2024, 00h44
mokhtar72

1 pièce(s) jointe(s)

Difficulté mathématique m'empêchant de coder un algorithme

Bonjour!
Avant tout je tiens à préciser que je ne suis pas une bête de la programmation, et que par ailleurs, j'ai passé beaucoup de temps à essayer de résoudre mon problème avant de décider de le poster sur ce forum. Je ne m'attends à ce qu'on m'envoie un code tout prêt mais des pistes de solutions si possible. Merci d'avance!
Voici mon problème:

J’ai une table de données d’ouvriers avec, entre autres, 2 champs : « ID » de l’ouvrier et « Coefficient » attribué à l’ouvrier.
Les coefficients peuvent prendre des valeurs décimales entre 0 et 1.77
La somme de tous les coefficients donne un chiffre qu’on appelle « Nb_Superviseurs » (nombre total de superviseurs).
Je voudrais un algorithme qui parcours tous les coefficients de la table, et « répartit » les ouvriers sur les superviseurs selon les critères suivants :
1. Si « Coefficient » = 1, alors l’ouvrier correspondant est attribué à 1 superviseur qui prend en charge à 100% cet ouvrier. Et ce superviseur ne prend pas en charge d’autres ouvriers (il atteint 100% de sa capacité).
2. Si « Coefficient » > 1, alors l’ouvrier correspondant est attribué à 2 superviseurs : 1 superviseur le prend en charge à 100% et un 2ème superviseur le prend en charge à un certain taux déterminé par le coefficient (partie décimale du coefficient). Donc, le 1er superviseur ne prend pas en charge d’autres ouvriers, et le 2ème superviseur peut prendre en charge d’autres ouvriers. Par exemple : si « Coefficient » = 1.6 (1 + 0.6), alors l’ouvrier sera pris en charge par un superviseur à 100% (1) et par un autre superviseur à 60% (0.6). Donc ce dernier, peut prendre en charge un autre (ou des autres) ouvrier(s) à raison de 40% de son temps (0.4).
3. Si « Coefficient » < 1, alors l’ouvrier correspondant est attribué à 1 superviseur qui le prendra en charge au taux déterminé par le coefficient. Par exemple, si « Coefficient » = 0.8, alors l’ouvrier sera pris en charge par un superviseur à 80% (0.8).
4. Tous les ouvriers doivent être répartis sur tous les superviseurs, en sachant que le nombre des superviseurs est « Nb_Superviseurs », calculé précédemment à partir de la somme de tous les coefficients.
5. Chaque superviseur doit prendre en charge un ou des ouvriers de façon à ce que le total des coefficients des ouvriers doit être égal, tout au plus, à 1 (un superviseur ne peut pas consacrer plus que 100% de son temps pour prendre en charge les ouvriers).
6. Un superviseur peut prendre en charge autant d’ouvriers qu’il faut, de façon à ce que le total des coefficients des ouvriers doit être égal, tout au plus, à 1 (max 1).
7. Chaque superviseur doit prendre en charge au moins 1 ouvrier
8. Un ouvrier peut être pris en charge par plus qu'un superviseur

Je voudrais que le programme affiche la répartition des ouvriers sur les superviseurs en précisant les « ID » et « Coefficient » de chaque ouvrier, et en précisant le total des coefficients des ouvriers pris en charge par chacun des superviseurs

Exemple :

J’ai 10 ouvriers dont voici les données stockées dans la table :

ID Coefficient
1 1.3
2 0.8
3 1
4 0.4
5 1.6
6 1
7 0.6
8 0.5
9 1.1
10 0.7

Somme des coefficients = 9, donc je dois avoir 9 superviseurs.

NB. : Si la somme donne un chiffre décimal, alors le nombre des superviseurs = partie entière de la somme + 1

Le programme doit répartir les 10 ouvriers sur les 9 superviseurs selon les critères décrits plus haut, et afficher la répartition comme montré dans la page suivante :
Schéma d’une possibilité de répartition des 10 ouvriers sur les 9 superviseurs :

Pièce jointe 653734
25/04/2024, 10h29
star

Bonjour,
Avant tout, je voudrais juste relever la clarté de tes explications et une rédaction concise et suffisante.

Citation:

... j'ai passé beaucoup de temps à essayer de résoudre mon problème avant de décider de le poster sur ce forum. Je ne m'attends pas à ce qu'on m'envoie un code tout prêt mais des pistes de solutions si possible.

Pourrais-tu poster ci-après le code que tu aurais d'ores et déjà pu écrire pour solutionner ton problème ?
.

Citation:

Envoyé par star

Bonjour,
Avant tout, je voudrais juste relever la clarté de tes explications et une rédaction concise et suffisante.

Pourrais-tu poster ci-après le code que tu aurais d'ores et déjà pu écrire pour solutionner ton problème ?
.

Merci pour ta répose star, c'est très apprécié.

Je te préviens, le code est toujours en stade "brouillon". J'ai l'impression que je tourne autour de la solution, il me maque la partie où je dois comparer les ratios inférieurs à 1, les aditionner de façon qu'à chaque fois que la somme est 1, les ouvriers concernés sont attribués à un superviseur.

Voici le code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Dim base As Database: Dim enr As Recordset: Dim ratio As Single
Dim Nb_Sup As Integer ' Nombre de superviseurs
Dim Nb_Ouv As Integer ' compteur du nombre d'ouvriers
 
 
Set base = CurrentDb()
Set enr = base.OpenRecordset("Questionnaire_Jour")
ratio = 0#
Nb_Sup = 0
donnees.Value = ""   'Champs texte pour afficher les résultats
Nb_Pat = 0
 
With enr
 
If .RecordCount <> 0 Then
'Calculer le nombre de superviseurs nécessaires et le nombre d'ouvrisrs mesurés pour la journée du 06 fév.
    .MoveFirst
 
    Do
        If .Fields("Date_concernee").Value = #2/6/2024# Then
            ratio = Round(ratio + .Fields("Ratio_Jour").Value, 1)   'Calculer le ratio général
            Nb_Ouv = Nb_Ouv + 1  'Compter Nb. ouvriers pour la date concernée
        End If
 
        .MoveNext
 
    Loop While Not .EOF
 
Nb_Sup = Int(ratio) + 1   'Nb de superviseurs nécessaires
donnees.Value = "Le ratio général: " & ratio & " / " & "Nn. de superviseurs: " & Nb_Sup & " / " & "Nb. ouvriers: " & Nb_Ouv & "<br />"
 
 
Dim Pat_Inf() As Variant   'Tableau principal qui va contenir la répartition des ouvriers sur les superviseurs
Dim l As Integer   'indice pour le tableau principal
l = 1   'initialiser l'indice du tableau principal
 
'Compter le nombre de ratios >1 et =1 et <1
Dim NbSup As Integer   'compteur des ratios sup. à 1
Dim Nb As Integer       'compteur des ratios égaux à 1
Dim NbInf As Integer   'compteur des ratios inf. à 1
NbSup = 0
Nb = 0
NbInf = 0
 
        .MoveFirst
 
        Do
            If .Fields("Date_concernee").Value = #2/6/2024# And .Fields("Ratio_Jour").Value > 1 Then
                NbSup = NbSup + 1
            ElseIf .Fields("Date_concernee").Value = #2/6/2024# And .Fields("Ratio_Jour").Value = 1 Then
                Nb = Nb + 1
            ElseIf .Fields("Date_concernee").Value = #2/6/2024# And .Fields("Ratio_Jour").Value < 1 Then
                NbInf = NbInf + 1
            End If
 
        .MoveNext
 
        Loop While Not .EOF
 
Dim taille1 As Integer
taille1 = 2 * NbSup + Nb + NbInf
 
ReDim Ouv_Sup(1 To taille1, 1 To 4)
 
 
        .MoveFirst
 
        Do
            If .Fields("Date_concernee").Value = #2/6/2024# And Round(.Fields("Ratio_Jour").Value, 1) > 1 Then
                    Ouv_Sup(l, 1) = .Fields("ID_Ouvrier").Value   'Stocker le #ID de l'Ouvrier
                    Ouv_Sup(l, 2) = Round(.Fields("Ratio_Jour").Value, 1)   'Stocker le ratio de l'ouvrier
                    Ouv_Sup(l, 3) = Int(.Fields("Ratio_Jour").Value)    'Stocker la partie entière du ratio ouvrier prise en charge par le sup. (=1)
                    Ouv_Sup(l, 4) = Round(.Fields("Ratio_Jour").Value - Int(.Fields("Ratio_Jour").Value), 1)   'Stocker partie décimale du ratio ouvrier. (partie qui va être prise en charge par un autre sup.
                    Ouv_Sup(l + 1, 1) = .Fields("ID_Ouvrier").Value
                    Ouv_Sup(l + 1, 2) = Round(.Fields("Ratio_Jour").Value - Int(.Fields("Ratio_Jour").Value), 1)
                    Ouv_Sup(l + 1, 3) = Round(.Fields("Ratio_Jour").Value - Int(.Fields("Ratio_Jour").Value), 1)
                    Ouv_Sup(l + 1, 4) = 0
                    l = l + 2
            ElseIf .Fields("Date_concernee").Value = #2/6/2024# And Round(.Fields("Ratio_Jour").Value, 1) = 1 Then
                    Ouv_Sup(l, 1) = .Fields("ID_Ouvrier").Value   'Stocker le #ID de l'Ouvrier
                    Ouv_Sup(l, 2) = Round(.Fields("Ratio_Jour").Value, 1)   'Stocker le ratio ouvrier
                    Ouv_Sup(l, 3) = Round(.Fields("Ratio_Jour").Value, 1)    'Stocker la partie entière du ratio ouv. prise en charge par le sup. (=1)
                    Ouv_Sup(l, 4) = 0
                    l = l + 1
            ElseIf .Fields("Date_concernee").Value = #2/6/2024# And Round(.Fields("Ratio_Jour").Value, 1) < 1 Then
                    Pat_Sup(l, 1) = .Fields("ID_Ouvrier").Value   'Stocker le #ID de l'Ouvrier
                    Pat_Sup(l, 2) = Round(.Fields("Ratio_Jour").Value, 1)   'Stocker le ratio de l'ouvrier
                    Pat_Sup(l, 3) = Round(.Fields("Ratio_Jour").Value, 1)
                    Pat_Sup(l, 4) = 0
                    l = l + 1
            End If
 
        .MoveNext
 
        Loop While Not .EOF
 
    ' Accéder aux éléments du tableau de tableaux contenant les #ID des ouvriers et leurs ratios
    For l = 1 To taille1
            donnees.Value = donnees.Value & "Ouvrier (" & l & "):  " & "# ID: " & Pat_Sup(l, 1) & " , Ratio ouvrier: " & Pat_Sup(l, 2) & " , Ratio pris en charge par le sup.: " & Pat_Sup(l, 3) & " , Partie du ratio pris en charge par un autre sup. " & Pat_Sup(l, 4) & "<br />"
    Next l

25/04/2024, 20h50
star

Bonjour,

Je te propose de procéder de la manière suivante : Découper l'algorithme en autant de parties pour obtenir le plan d'exécution. Il s'agit en fait d'écrire les spécifications de l'algo en langage usuel (français ou anglais si tu préfères). Je penses que cette approche t'aidera beaucoup plus à trouver la solution au problème posé plutôt que de chercher à coder d'emblée.

Pour ce faire, je te soumets une première action à faire à mon humble avis :

1 - Déterminer le nombre total de superviseurs
2 - ...
3

Je te laisse le soin de poursuivre ce qui nous permettra d'en discuter au fur et à mesure
.

2 pièce(s) jointe(s)

Bonjour mokhtar72,

La question posée est intéressante. Voici une approche avec son code.

Une requête pour sortir les employés et leurs ratios. Dans mon exemple "T_Work".
Une fonction pour déterminer le nombre de superviseurs.
Deux tables pour récupérer les données.
La première table que j'ai nommée "T_Work_Temp" qui est populée par une boucle et qui divise les tâches exemple: 1.77 = un record 1 et un record 0.77
La deuxième table pour inscrire les résultats.
Une sub pour diviser les tâches et populée la table "T_Work_Temp".
Une sub pour remplir un tableau basé sur cette table.
Une sub pour populée la deuxième table, celle des résultats nommée "T_Work_Control". Cette sub divisée en fonctions récursives.

Dans un module standard le code suivant:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
Option Compare Database
Option Explicit
 
Public Sub RepartirTravail()
'Le sub principal qui appel les autres
'Vous pouvez l'utiliser directement ou l'appeler à partir d'un formulaire
 
    ViderEtRemplirLaTable
    DiviserTache
    RemplirControl
 
End Sub
Private Function fuControl() As Long
'Fonction qui retourne le nombre de superviseurs nécessaire
 
    fuControl = fRoundUp(DSum("Work_Rate", "T_Work")) ' À modifier avec le nom de votre requête mon point 1
 
End Function
Private Function fRoundUp(NbrToRound As Variant) As Long
'Fonction qui arrondi en haut
 
    fRoundUp = 0
    If Not IsNull(NbrToRound) Then
       fRoundUp = -Int(-NbrToRound)
    End If
 
End Function
Private Function AddRemplirReste(rst As DAO.Recordset, sWork_FK As Variant, lRate As Long) As Long
'Fonction qui inscrit les employés dans superviseurs incomplets
On Error GoTo gestion_err
Dim lReste                      As Long
 
    rst.Edit
    If lRate > 100 - rst(2) Then
        lReste = lRate - (100 - rst(2))
        rst(1) = rst(1) & sWork_FK & "(" & 100 - rst(2) & "%)"
        rst(2) = 100
        rst.Update
 
        rst.MoveNext
    Else
        rst(1) = rst(1) & sWork_FK & "(" & lRate & "%)"
        lReste = 0
        rst(2) = rst(2) + lRate
        rst.Update
    End If
    AddRemplirReste = lReste
 
Sortie:
Exit Function
On Error Resume Next
gestion_err:
    MsgBox "Erreur imprévue dans la sub AddRemplirReste" _
    & Chr(13) & Err.Description _
    & Chr(13) & "Erreur # " & Err.Number, vbCritical
    Resume Sortie
End Function
Private Sub ViderEtRemplirLaTable()
'Sub qui inscrit les enregistrements nécessaires pour la répartitions
On Error GoTo gestion_err
Dim db                          As DAO.Database: Set db = CurrentDb
Dim rst                         As DAO.Recordset
Dim strSQL                      As String
Dim l                           As Long
Dim i                           As Long
 
    strSQL = "DELETE T_Work_Control.* FROM T_Work_Control;"
    db.Execute strSQL, dbFailOnError
    l = fuControl()
    strSQL = "SELECT T_Work_Control.* FROM T_Work_Control;"
    Set rst = db.OpenRecordset(strSQL, 2, 512)
    For i = 1 To l
        rst.AddNew
            rst("Control_ID") = i
        rst.Update
    Next i
 
Sortie:
Exit Sub
On Error Resume Next
rst.Close
Set rst = Nothing
Set db = Nothing
gestion_err:
    MsgBox "Erreur imprévue dans la sub ViderEtRemplirLaTable" _
    & Chr(13) & Err.Description _
    & Chr(13) & "Erreur # " & Err.Number, vbCritical
    Resume Sortie
End Sub
Private Sub DiviserTache()
'Sub qui divise les tâches
On Error GoTo gestion_err
Dim db                          As DAO.Database: Set db = CurrentDb
Dim rst                         As DAO.Recordset
Dim strSQL                      As String
Dim c                           As Currency
 
    strSQL = "DELETE T_Work_Temp.* FROM T_Work_Temp;"
    db.Execute strSQL, dbFailOnError
'Ici vous devrez modifier le select pour récupérer vos données.  
'Pour mon exemple je récupère un nom qui est unique et le ratio
    strSQL = "SELECT T_Work.Work_ID, T_Work.Work_Rate FROM T_Work " _
    & "ORDER BY T_Work.Work_Rate DESC;"
    Set rst = db.OpenRecordset(strSQL, 4, 512)
    Do While Not rst.EOF
        c = rst(1) - 1
        If c >= 0 Then
            strSQL = "INSERT INTO T_Work_Temp ( Work_ID, Work_Rate ) " _
            & "VALUES('" & rst(0) & "', 1);"
            db.Execute strSQL, dbFailOnError
            If c > 0 Then
                strSQL = "INSERT INTO T_Work_Temp ( Work_ID, Work_Rate ) " _
                & "VALUES('" & rst(0) & "', " & rst(1) - 1 & ");"
                db.Execute strSQL, dbFailOnError
            End If
        Else
            strSQL = "INSERT INTO T_Work_Temp ( Work_ID, Work_Rate ) " _
                & "VALUES('" & rst(0) & "', " & rst(1) & ");"
                db.Execute strSQL, dbFailOnError
        End If
        rst.MoveNext
    Loop
 
Sortie:
Exit Sub
On Error Resume Next
rst.Close
Set rst = Nothing
Set db = Nothing
gestion_err:
    MsgBox "Erreur imprévue dans la sub DiviserTache" _
    & Chr(13) & Err.Description _
    & Chr(13) & "Erreur # " & Err.Number, vbCritical
    Resume Sortie
End Sub
Private Sub RemplirTableau(Tableau() As Variant)
'Sub qui popule le tableau nécessaire pour la répartition
'Basé sur la table de mon point 4
On Error GoTo gestion_err
Dim db                          As DAO.Database: Set db = CurrentDb
Dim rst                         As DAO.Recordset
Dim strSQL                      As String
Dim l                           As Long
 
    l = DCount("*", "T_Work_Temp")
    ReDim Tableau(l - 1, 3)
 
    strSQL = "SELECT T_Work_Temp.Work_ID, T_Work_Temp.Work_Rate " _
    & "FROM T_Work_Temp ORDER BY T_Work_Temp.Work_Rate DESC;"
    Set rst = db.OpenRecordset(strSQL, 4, 512)
    l = 0
    Do While Not rst.EOF
        Tableau(l, 0) = l
        Tableau(l, 1) = "(" & rst(0) & "/" & DLookup("Work_Rate", "T_Work", "[Work_ID]=" & Chr(34) & rst(0) & Chr(34)) & ")"
        Tableau(l, 2) = rst(1) * 100
        Tableau(l, 3) = 0
        l = l + 1
        rst.MoveNext
    Loop
 
Sortie:
Exit Sub
On Error Resume Next
rst.Close
Set rst = Nothing
Set db = Nothing
gestion_err:
    MsgBox "Erreur imprévue dans la sub RemplirTableau" _
    & Chr(13) & Err.Description _
    & Chr(13) & "Erreur # " & Err.Number, vbCritical
    Resume Sortie
End Sub
Private Sub RemplirControl()
'Sub qui inscrit les employés à leurs superviseurs
'Table de mon point 8
On Error GoTo gestion_err
Dim db                          As DAO.Database: Set db = CurrentDb
Dim rst                         As DAO.Recordset
Dim strSQL                      As String
Dim vaTableau()                 As Variant
Dim l                           As Long
Dim lRate                       As Long
 
    RemplirTableau vaTableau
    strSQL = "SELECT Control_ID, Work_FK, Rate " _
    & "FROM T_Work_Control WHERE Rate = 0;"
    Set rst = db.OpenRecordset(strSQL, 2, 512)
        For l = 0 To UBound(vaTableau)
        If Not rst.EOF Then
            If vaTableau(l, 2) = 100 And vaTableau(l, 3) = 0 Then
                rst.Edit
                rst(1) = vaTableau(l, 1) & "(100%)"
                rst(2) = 100
                rst.Update
                vaTableau(l, 3) = 100
                rst.MoveNext
            ElseIf vaTableau(l, 3) = 0 Then
                rst.Edit
                rst(1) = vaTableau(l, 1) & "(" & vaTableau(l, 2) & "%)"
                rst(2) = vaTableau(l, 2)
                rst.Update
                vaTableau(l, 3) = vaTableau(l, 2)
                AddRemplir rst, vaTableau, 100 - rst(2)
                rst.MoveNext
            End If
        End If
        Next
        rst.Close
        Set rst = Nothing
        strSQL = "SELECT Control_ID, Work_FK, Rate " _
        & "FROM T_Work_Control WHERE Rate < 100 " _
        & "ORDER BY T_Work_Control.Rate;"
        Set rst = db.OpenRecordset(strSQL, 2, 512)
        For l = 0 To UBound(vaTableau)
            If vaTableau(l, 2) <> vaTableau(l, 3) Then
                lRate = vaTableau(l, 2)
                Do While lRate > 0
                    lRate = AddRemplirReste(rst, vaTableau(l, 1), lRate)
                    If lRate = 0 Then: vaTableau(l, 3) = vaTableau(l, 2)
                Loop
            End If
        Next
 
Sortie:
Exit Sub
On Error Resume Next
rst.Close
Set rst = Nothing
Set db = Nothing
gestion_err:
    MsgBox "Erreur imprévue dans la sub RemplirLesComplets" _
    & Chr(13) & Err.Description _
    & Chr(13) & "Erreur # " & Err.Number, vbCritical
    Resume Sortie
End Sub
Private Sub AddRemplir(rst As DAO.Recordset, vaTableau() As Variant, Limite As Long)
'Sub récursive pour compléter la sub RemplirControl
On Error GoTo gestion_err
Dim l                           As Long
Dim Trouve                      As Boolean
 
    For l = LBound(vaTableau) To UBound(vaTableau)
        If vaTableau(l, 2) <= Limite And vaTableau(l, 3) = 0 Then
            Trouve = True
            rst.Edit
            rst(1) = rst(1) & vaTableau(l, 1) & "(" & vaTableau(l, 2) & "%)"
            rst(2) = vaTableau(l, 2) + rst(2)
            rst.Update
            vaTableau(l, 3) = vaTableau(l, 2)
            Limite = 100 - rst(2)
            If Trouve Then: AddRemplir rst, vaTableau, Limite
        End If
    Next
Sortie:
Exit Sub
On Error Resume Next
gestion_err:
    MsgBox "Erreur imprévue dans la sub AddRemplir" _
    & Chr(13) & Err.Description _
    & Chr(13) & "Erreur # " & Err.Number, vbCritical
    Resume Sortie
End Sub

Voici la structure des deux tables:
Pièce jointe 653842
Voici le résultat à partir de "T_Work" pour mon exemple:
Pièce jointe 653843
La table "T_Work_Control" se présente comme suit:
Control_ID = un superviseur
Work_FK = (Le nom de l'employé/son ratio)(le pourcentage utilisé du superviseur/employé)
Rate = le pourcentage utilisé du superviseur

Bonne journée

26/04/2024, 03h15
star
Bonjour,
Citation:
Voici une approche avec son code.

Une requête pour sortir les employés et leurs ratios. Dans mon exemple "T_Work".
Une fonction pour déterminer le nombre de superviseurs.
Deux tables pour récupérer les données.
La première table que j'ai nommée "T_Work_Temp" qui est populée par une boucle et qui divise les tâches exemple: 1.77 = un record 1 et un record 0.77
La deuxième table pour inscrire les résultats.
Une sub pour diviser les tâches et populée la table "T_Work_Temp".
Une sub pour remplir un tableau basé sur cette table.
Une sub pour populée la deuxième table, celle des résultats nommée "T_Work_Control". Cette sub divisée en fonctions récursives.
J'aurai une autre approche à proposer avec une seule table des résultats directement :
1. Supprimer les enregistrements de la table des résultats
2. Déterminer le nombre total de superviseurs
3. Boucler sur les employés :
4. Boucler sur les superviseurs :
5. Déterminer en interrogeant la table des résultats si le superviseur courant peut prendre en charge l'employé courant et à quel ratio
6. Si oui, créer la prise en charge en insérant un enregistrement dans la table des résultats avec tous les paramètres nécessaires
7. Si non, poursuivre avec le superviseur suivant
8. A épuisement du nombre total de superviseurs pour l'employé courant (cas peu probable) ou lorsque l'employé courant est pris en charge totalement par un, plusieurs ou l'ensemble des superviseurs (cas plus probable), poursuivre avec l'employé suivant
9. Procéder à la restitution des résultats regroupés par superviseur, employé
La discussion reste ouverte
.
26/04/2024, 06h13
User

En complément

Bonjour,

Oui, pour essayer d'y voir plus clair, une approche complémentaire sans parler du code car beaucoup de choses importantes ont déjà été proposées :

Comme ça a été dit, il faudrait déjà éclater ces coefficients en partie entière (1) + partie décimale (1.3 = 1 + 0.3) :

id_ouvrier Coefficient
1 1.0
1 0.3
2 0.8
3 1
4 0.4
5 1.0
5 0.6
6 1
7 0.6
8 0.5
9 1.0
9 0.1
10 0.7

(coefs<=1)

Ensuite, on cherche à répartir ces n=13 couples de valeurs (id_ouvrier, coef) sur les k=9 superviseurs.

k = nb_superviseurs = somme des coefs arrondie à l'entier supérieur.

1re étape :

On peut déjà choisir k=9 couples (avec coef <=1) parmi les n=13 couples pour les associer à 9 superviseurs.

On choisit en priorité les coefs valant 1 pour optimiser leur répartition.

Il y a en fait autant de façons de les choisir que d'arrangements de k=9 éléments pris parmi n=13, donc déjà en choisir un serait bien car le nombre est énorme ;)

2e étape :

Une fois les 9 coefs (<=1) (ou couples) associés aux 9 superviseurs (1 arrangement possible), il ne reste "plus" qu'à dispacher les 13-9 = 4 coefs restant sur les 9 superviseurs de façon à respecter la condition pour chaque superviseur : somme coefs sur 1 superviseur <=1.

Sans bien sûr parler de code..

Cdlt,
26/04/2024, 11h41
star

Bonjour,

Citation:

Comme ça a été dit, il faudrait déjà éclater ces coefficients en partie entière (1) + partie décimale (1.3 = 1 + 0.3)

Je ne pense pas que cette étape soit requise.
La capacité d'un superviseur à traiter un employé peut être déduite au file de l'eau suivant les ratios d'employés déjà comptabilisés pour ce superviseur.
Je ne sais pas si je suis assez clair dans mes explications.
L'intérêt étant de proposer des solutions, c'est ce qui importe sur toute autre considération.
Merci
.
26/04/2024, 13h22
mokhtar72

Citation:

Envoyé par Robert1957

Bonjour mokhtar72,

La question posée est intéressante. Voici une approche avec son code.

WOW! Merci beaucoup Robert pour votre temps et votre volonté de me donner un coup de main. Je vais prendre le temps de "digérer" votre solution et vous revenir avec ma rétroaction! :-)

Bonne journée,

Bonjour User,

Merci votre explication est plus claire que la mienne et c'est exactement ce que fait le code proposé. En me relisant je viens de constater que la sub "DiviserTache()" est mal conçue, elle est efficace mais limitée au nombre maximum de 1.99. Il serait mieux de faire une boucle pour déterminer le nombre d'entier et le reste, ainsi si on avait un 3.77 on créerait 3 enregistrements de 1 et un autre de 0.77. Voici le code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Private Sub DiviserTache1()
'Sub qui divise les tâches
On Error GoTo gestion_err
Dim db                          As DAO.Database: Set db = CurrentDb
Dim rst                         As DAO.Recordset
Dim strSQL                      As String
Dim l                           As Long
Dim i                           As Long
 
    strSQL = "DELETE T_Work_Temp.* FROM T_Work_Temp;"
    db.Execute strSQL, dbFailOnError
    strSQL = "SELECT T_Work.Work_ID, T_Work.Work_Rate FROM T_Work " _
    & "ORDER BY T_Work.Work_Rate DESC;"
    Set rst = db.OpenRecordset(strSQL, 4, 512)
    Do While Not rst.EOF
        l = Int(rst(1))
        For i = 1 To l  'Insertion des entiers
            strSQL = "INSERT INTO T_Work_Temp ( Work_ID, Work_Rate ) " _
            & "VALUES('" & rst(0) & "', 1);"
            db.Execute strSQL, dbFailOnError
        Next
        If rst(1) - l > 0 Then 'Insertion des fractions si elles existent
            strSQL = "INSERT INTO T_Work_Temp ( Work_ID, Work_Rate ) " _
            & "VALUES('" & rst(0) & "', " & rst(1) - Int(rst(1)) & ");"
            db.Execute strSQL, dbFailOnError
        End If
        rst.MoveNext
    Loop
 
Sortie:
Exit Sub
On Error Resume Next
rst.Close
Set rst = Nothing
Set db = Nothing
gestion_err:
    MsgBox "Erreur imprévue dans la sub DiviserTache" _
    & Chr(13) & Err.Description _
    & Chr(13) & "Erreur # " & Err.Number, vbCritical
    Resume Sortie
End Sub

Bonne journée

27/04/2024, 19h07
User

Citation:

Envoyé par Robert1957

Bonjour User,

Merci votre explication est plus claire que la mienne et c'est exactement ce que fait le code proposé. ...

Merci à vous ;)
27/04/2024, 19h37
mokhtar72

Merci beaucoup à vous 3 (star, Robert1957, User) d'avoir contribué à m'aider à avancer dans mon projet.
Je vous reviens avec mes commentaires aussitôt que j'aurai implémenté l'algorithme.
À bientôt!

1 pièce(s) jointe(s)

Citation:
Envoyé par Robert1957
Bonjour User,

Merci votre explication est plus claire que la mienne et c'est exactement ce que fait le code proposé. En me relisant je viens de constater que la sub "DiviserTache()" est mal conçue, elle est efficace mais limitée au nombre maximum de 1.99. Il serait mieux de faire une boucle pour déterminer le nombre d'entier et le reste, ainsi si on avait un 3.77 on créerait 3 enregistrements de 1 et un autre de 0.77. Voici le code:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 Private Sub DiviserTache1() 'Sub qui divise les tâches On Error GoTo gestion_err Dim db As DAO.Database: Set db = CurrentDb Dim rst As DAO.Recordset Dim strSQL As String Dim l As Long Dim i As Long strSQL = "DELETE T_Work_Temp.* FROM T_Work_Temp;" db.Execute strSQL, dbFailOnError strSQL = "SELECT T_Work.Work_ID, T_Work.Work_Rate FROM T_Work " _ & "ORDER BY T_Work.Work_Rate DESC;" Set rst = db.OpenRecordset(strSQL, 4, 512) Do While Not rst.EOF l = Int(rst(1)) For i = 1 To l 'Insertion des entiers strSQL = "INSERT INTO T_Work_Temp ( Work_ID, Work_Rate ) " _ & "VALUES('" & rst(0) & "', 1);" db.Execute strSQL, dbFailOnError Next If rst(1) - l > 0 Then 'Insertion des fractions si elles existent strSQL = "INSERT INTO T_Work_Temp ( Work_ID, Work_Rate ) " _ & "VALUES('" & rst(0) & "', " & rst(1) - Int(rst(1)) & ");" db.Execute strSQL, dbFailOnError End If rst.MoveNext Loop Sortie: Exit Sub On Error Resume Next rst.Close Set rst = Nothing Set db = Nothing gestion_err: MsgBox "Erreur imprévue dans la sub DiviserTache" _ & Chr(13) & Err.Description _ & Chr(13) & "Erreur # " & Err.Number, vbCritical Resume Sortie End Sub
Bonne journée
Bonjour Robert,

Merci encore pour votre grand soutien!
J'ai eu quelques messages d'erreurs dont la plupart j'ai pu résoudre. J'ai encore de la difficulté avec l'erreur 3346 concernant la Sub DiviserTache (détail du message d'erreur plus bas). J'ai essayé de le résoudre en m'assurant de la compatibilité du type de données entre les tables, sans succès. Auriez-vous des pistes de solution?
Merci,

Pièce jointe 654020

30/04/2024, 14h24
Robert1957

Bonjour mokhtar72,

À première vue, c'est un problème de langue. Votre Pc est probablement configuré "Français" et de ce fait écrit les nombres "1,6" et une instruction SQL doit être écrite en anglais "1.6". Pour corriger ce problème à la ligne 24 écrire plutôt:

Code:

& "VALUES('" & rst(0) & "', CDbl('" & rst(1) - Int(rst(1)) & "'));"

Bonne journée

bonjour,
en France, la virgule est le même caractère que le séparateur de champs dans SQL, il y a donc erreur d'interprétation de la commande. Avec l'instruction INSER INTO, je recommande toujours de mettre des apostrophes autour de toutes les valeurs à insérer.
Ici il en manquait autour pour Work_Rate:
Code:

1 2 3 4 5 If rst(1) - l > 0 Then 'Insertion des fractions si elles existent strSQL = "INSERT INTO T_Work_Temp ( Work_ID, Work_Rate ) " _ & "VALUES('" & rst(0) & "', '" & rst(1) - Int(rst(1)) & "');" db.Execute strSQL, dbFailOnError End If

Citation:
Envoyé par tee_grandbois
bonjour,
en France, la virgule est le même caractère que le séparateur de champs dans SQL, il y a donc erreur d'interprétation de la commande. Avec l'instruction INSER INTO, je recommande toujours de mettre des apostrophes autour de toutes les valeurs à insérer.
Ici il en manquait autour pour Work_Rate:
Code:

1 2 3 4 5 If rst(1) - l > 0 Then 'Insertion des fractions si elles existent strSQL = "INSERT INTO T_Work_Temp ( Work_ID, Work_Rate ) " _ & "VALUES('" & rst(0) & "', '" & rst(1) - Int(rst(1)) & "');" db.Execute strSQL, dbFailOnError End If
Merci, mais ça ne fonctionne toujours pas. je continue de chercher...

03/05/2024, 23h40
mokhtar72

Citation:

Envoyé par Robert1957

Bonjour mokhtar72,

À première vue, c'est un problème de langue. Votre Pc est probablement configuré "Français" et de ce fait écrit les nombres "1,6" et une instruction SQL doit être écrite en anglais "1.6". Pour corriger ce problème à la ligne 24 écrire plutôt:

Code:

& "VALUES('" & rst(0) & "', CDbl('" & rst(1) - Int(rst(1)) & "'));"

Bonne journée

Merci encore! Le problème est que suite à cette modification, les tables T_Work_Temp et T_Work_Contrl ne se remplissent pas (restent vides après le lancement de l'algorithme. Je continue de chercher les causes...
05/05/2024, 14h21
Robert1957

1 pièce(s) jointe(s)

Bonjour mokhtar72,

N'ayant pas les détails de votre Bd voici un exemple fonctionnel. La table "T_Work" remplace votre table des ouvriers, vous avez juste à faire la substitution. Naturellement le ID de l'ouvrier doit être unique. J'ai modifié la sub "DiviserTache" pour qu'elle fonctionne avec des ",".

Bonne journée
06/05/2024, 04h26
mokhtar72

Citation:

Envoyé par Robert1957

Bonjour mokhtar72,

N'ayant pas les détails de votre Bd voici un exemple fonctionnel. La table "T_Work" remplace votre table des ouvriers, vous avez juste à faire la substitution. Naturellement le ID de l'ouvrier doit être unique. J'ai modifié la sub "DiviserTache" pour qu'elle fonctionne avec des ",".

Bonne journée

C'est tout bonnement FORMIDABLE! Ça fonctionne à merveille. Robert, je vois sur votre profil que vous êtes au Canada. Si vous êtes sur Montréal ou les environs, je me ferais un plaisir de vous offrir un déjeuner!! :)