Discussion :

[VincentCA]

Bonjour,

Le principe est que la formule random tire aléatoirement pour la ligne 2, 2A/1B/3C/1D/1E paris 10 employés.

A partir de l'exemple suivant, pourriez vous m'aider s'il vous plait à trouver une formule afin d'automatiser un roulement équitable ?

Exemple
A2 = 2
A1=A

Répartition aléatoire de A(A1) en 2 exemplaires(A2) sur L2 à BD2. Soit en L2 et P2 on retrouve A ou en AB2 et AV2 ou en X2 et AN2...ici je choisirai L2 et P2 en aléatoire.

Une fois réalisée, on ajoute B1=B avec B2=1 et pareil aléatoirement, on comble les cellules vides de L2 à BD2. Si L2 et P2 étaient en A, X2 pourrait être en B.


Une fois réalisée, on ajoute C1=C avec C2=3 et pareil aléatoirement, on comble les cellules vides de L2 à BD2 sachant que si L2 et P2 étaient en A, X2 en B, AV2 et AZ2 et BD2 pourraient être en C

Une fois réalisée, on ajoute D1=D avec D2=1 et pareil aléatoirement, on comble les cellules vides de L2 à BD2 sachant que si L2 et P2 étaient en A, X2 en B, AV2 et AZ2 et BD2 en C, T2 pourrait être en D

Une fois réalisée, on ajoute E1=E avec E2=1 et pareil aléatoirement, on comble les cellules vides de L2 à BD2 sachant que si L2 et P2 étaient en A, X2 en B, AV2 et AZ2 et BD2 en C, T2 en D, AF2 pourrait être en E.

Alors AB2 et AN2 seraient vides.

Puis on reproduit cela de façon aléatoire pour mardi, mercredi, jeudi et vendredi.

Merci beaucoup de votre aide

[Menhir]

https://www.developpez.net/forums/d8...s-discussions/

[ARTURO83]

Bonjour,

-Pour ce qui n'ouvrent pas les fichiers, voici le tableau de VincentCA
Pièce jointe 476415

-Pour plus de clarté, création d'un tableau intermédiaire
Pièce jointe 476418

Le code associé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Tirage_aleatoire()
    Dim Valeur As String
    Dim Nb_Tirage As Integer, Nb_Alea As Integer
    Application.ScreenUpdating = False
    Range("G11:P15").ClearContents 'on efface les précédents tirages
    For i = 11 To 15 'tirage pour la semaine
        For j = 2 To 6 'les valeurs à placer
            Valeur = Cells(10, j)
            Nb_Tirage = Cells(i, j)
            For t = 1 To Nb_Tirage
                Randomize 'Initialise le générateur de nombres aléatoires
Tirage_aleatoire:
                Nb_Alea = Int(10 * Rnd) + 1 'Nombre aléatoire entier entre 1 et 10
                If Cells(i, Nb_Alea + 6) = "" Then 'Si l'employé est libre
                    Cells(i, Nb_Alea + 6) = Valeur 'on y met la valeur
                Else
                    GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire
                End If
            Next t
        Next j
    Next i
 
    'Recupération du résultat dans le tableau
    Col = 7
    For i = 12 To 48 Step 4
        Range(Cells(2, i), Cells(6, i)).Value = Range(Cells(11, Col), Cells(15, Col)).Value
        Col = Col + 1
    Next i
End Sub

et le fichier
Pièce jointe 476422

Cdlt

[VincentCA]

Bonjour Arturo,
Ton code est une création de ta part ?
Pourrais tu m’aider stp à finaliser ma demande ?

[ARTURO83]

Bonjour,

Ton code est une création de ta part ? OUI, puisque le but est de répondre à la question posée, mais je n'ai fait qu'utiliser la fonction Random (qui est connue de la plupart des personnes qui répondent sur le forum) et l'ai adapté à la situation.
Pourrais tu m’aider stp à finaliser ma demande ? , Tout le monde peut vous aider, posez votre question et vous aurez des réponses assez rapidement.

Cdlt

[VincentCA]

Bonjour.

Ne disposant pas d’office365, je n’ai pour l’instant pas accès au développeur. De ce fait, j’ai fais avec quelques formules.
Sur un tableau aléatoire avec ALEA() suivi du formule RANG pour trier et rendre unique un nombre (toujours basé sur 11 employés). Ensuite j'ai pu CONCAT, REPT et EQUIV
Pensez vous qu’il soit possible de faire en sorte que sur les 5 jours d'une semaine, une tache ne revienne pas plus de 2 fois par employé ?
Exemple, le A qui reviendrait que 2 fois sur employé 1. Au delà de 2, la tâche deviendrait trop répétitive.
Attention, le fichier est en calcul manuel pour pas que l'aléatoire intervienne a chaque remplissage de cellule.

Si c’est mieux en BVA, je m’adapterai.

Merci d'avance pour tout,
Bonne soirée

[VincentCA]

Bonsoir ARTURO83,

J'avais pas vu votre fichier joint et il semble fonctionner en macro avec le bouton.
Toutefois, mes demandes ci-dessous sont toujours nécessaire pour l'équité...

MERCI

[ARTURO83]

Bonjour,

Ne disposant pas d’office365, je n’ai pour l’instant pas accès au développeur
Ajouter Développeur Excel Mac
Sélectionnez paramètresExcel _GT_ _GT_ barre d'outils & du ruban.
Sous personnaliser le ruban, sélectionnez onglets principaux, puis sélectionnez développeur.
Cliquez sur Enregistrer, puis fermez les Préférences Excel

toujours basé sur 11 employés Dans la première demande, c'était 10.

Avec les modifications demandées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Tirage_aleatoire()
    Dim Valeur As String
    Dim Nb_Tirage As Integer, Nb_Alea As Integer
    Application.ScreenUpdating = False
    Range("G11:Q15").ClearContents 'on efface les précédents tirages
    For i = 11 To 15 'tirage pour la semaine
        For j = 2 To 6 'les valeurs à placer
            Valeur = Cells(10, j)
            Nb_Tirage = Cells(i, j)
            For t = 1 To Nb_Tirage
                Randomize 'Initialise le générateur de nombres aléatoires
Tirage_aleatoire:
                'Conrôle par ligne, vérifie si l'employé est libre
                Nb_Alea = Int(11 * Rnd) + 1 'Nombre aléatoire entier entre 1 et 11
                If Cells(i, Nb_Alea + 6) = "" Then 'Si l'employé est libre
                    Cells(i, Nb_Alea + 6) = Valeur 'on y met la valeur
                Else
                    GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire
                End If
                'Contrôle par colonne, à partir du mercredi, vérifie que l'employé n'est pas occupé à faire 2 fois la même tâche
                If i > 12 Then
                    NbLigInter = i - 10
                    Plage = Cells(11, Nb_Alea + 6).Address & ":" & Cells(i - 1, Nb_Alea + 6).Address
                    If Application.WorksheetFunction.CountIf(Range(Plage), Valeur) = 2 Then
                        Cells(i, Nb_Alea + 6) = ""
                        GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire
                    End If
                End If
            Next t
        Next j
    Next i
 
    'Recupération du résultat dans le tableau
    Col = 7
    For i = 12 To 52 Step 4
        Range(Cells(2, i), Cells(6, i)).Value = Range(Cells(11, Col), Cells(15, Col)).Value
        Col = Col + 1
    Next i
End Sub

Avec le fichier

Pièce jointe 478226

Cdlt

[VincentCA]

Merci encore pour ces nouveaux travaux.
Pour être plus précis, je vais détailler ma demande avec beaucoup de rigueur et des exemples concrets :




1ère étape de mon tableau : désigner des nombres aléatoires de 0 à 1 avec la fonction ALEA (cellules de BN3:BX20)
Puis en deuxième étape, je procède à la determination de nombre entier entre 1 et 11 avec la fonction RANG (cellules de BC3:BM20).
Ces deux étapes me permettent ainsi d'attribuer des nombres entiers aléatoire de 1 à 11.

ARTURO83, il s'agit de la fonction random que vous utilisez dans le code VBA et je vous en remercie par avance...

Ensuite, en fonction du nombre inscrit dans les colonnes de A3:E20, je ventile la répartition des tâches à l'aide de la fonction REPT puis concatène les lettres dans l'ordre avec la fonction CONCAT.
Pour finir, j'attribue à chaque lettre sa position sur le rang par rapport à la concaténation. Exemple, sur la ligne 3, le numéro 3 (employé 3) dans rang apparait en première position, il prendra donc la première lettre dans la concaténation. Pour cet exemple, la concaténation était ABCCE donc lettre A pour l'employé 3.

ARTURO83, tout cela correspond à la fin de votre code BVA. Toutefois, il semblerait que dès lors que je modifie une valeur de A à E, rien ne se modifie. Or il est important que ca puisse évoluer car le nombre variera d'un jour à l'autre, d'une semaine à l'autre

Pour faire évoluer ce tableur, il faudrait raisonner également dans l'autre sens mais je ne sais pas trop faire : voici ma demande supplémentaire qui doit être traité en première me semble t'il.
Dans les colonnes N, R, V, Z AD, AH, AL,AP, AT, AX et BB, un chiffre correspondant à sa prise de poste va être mentionnée. Les employés travaillent seulement 4 jours par semaine.
Je vais prendre l'exemple sur la première semaine :
Au hasard, j'ai positionné les employés soit du lundi au jeudi, soit du mardi au vendredi, avec prise de poste à 20h et à 21h.
Vous remarquerez que le lundi et le vendredi, l'effectif est donc réduit puisqu'un salarié ne fait que 4 nuits successives par semaine.

La demande est la suivante : Est il possible de réaliser le random sur le nombre d'employés présent le jour en question. Si on prend la ligne 3, random sur 6 personnes. Si on prend la ligne 5, random sur 11 personnes.
La ventilation des tâches restera automatique en fonction du chiffre marqué dans les colonnes A3:E20. Si on prends la ligne3, 5 tâches sont ventilées sur 6 employés présents, l'employé 8 est donc sans tâche le lundi. Si on prend la ligne5, 8 tâches sur 11 employés présents, 3 sont sans tâches (4, 8 et 10).

Enfin pour terminer, il faudrait que le ou les employés qui sont mentionnés "20h" soit automatiquement de tâche C. Sur l'exemple, j'ai fais ça manuellement...
Mais en pratique, je positionne d'abord les prises de poste avant l'attribution aléatoire des tâches. Et non pas l'inverse ...
Il faut que ce soit le 20h qui génère le C et pas le C qui génère le 20h.

[ARTURO83]

Bonjour,

Le but d'un forum d'entraide est comme son nom l'indique est de dépanner ou d'apporter une aide, pas de développer une application complète.

Pour faire évoluer ce tableur, il faudrait raisonner également dans l'autre sens mais je ne sais pas trop faire : voici ma demande supplémentaire qui doit être traité en première me semble t'il. Là ça commence mal, ce qui aurait été fait précédemment ne va plus?

A votre remarque: il semblerait que dès lors que je modifie une valeur de A à E, rien ne se modifie. Or il est important que ça puisse évoluer car le nombre variera d'un jour à l'autre, d'une semaine à l'autre, je ne comprends pas, le bouton "Tirage aléatoire" a bien été fait pour régénérer une autre salve de nombres aléatoires Non? A moins que vous ne vouliez qu'un tirage au jour le jour et qui tienne compte et ne modifie pas les tirages des jours précédents.

Maintenant, les employés ne travaillent plus 5 jours mais 4 jours par semaine, avec effectif réduit le lundi et le vendredi. Où sont toutes ces conditions dans la demande initiale?

Est il possible de réaliser le random sur le nombre d'employés présent le jour en question, comment sait-on si l'employé est présent?

Enfin pour terminer, il faudrait que le ou les employés qui sont mentionnés "20h" soit automatiquement de tâche C. Cela signifie-t-il que la valeur 20h est déjà mise dans le tableau? Donc exclure du tirage aléatoire tous ceux qui sont marqués 20h et les marquer "C" avant tirage.

Toutes vos nouvelles doléances amènent de nouvelles questions, difficile dans ce cas d'être efficace et constructif.
Le problème, c'est que vous rajoutez des couches supplémentaires à chaque fois, donc le travail fait précédemment est à reprendre car ne correspond plus.
Si je reprends la demande initiale, le but était de générer des nombres aléatoires pour placer des employés sur 5 jours, ce qui a été fait jusqu'à présent correspondait bien à la demande, pour le reste avec les éléments fournis, je ne sais pas.

Cdlt

[VincentCA]

Bonjour,

Le but d'un forum d'entraide est comme son nom l'indique est de dépanner ou d'apporter une aide, pas de développer une application complète. Tout d’abord, avant toute chose, je tenais une nouvelle fois à vous remercier pour le temps que vous me consacrez. Aussi bien en m’aidant qu’en m’apportznt Votre vision des choses, j’apprends et j’évolue. Aller sur un forum d’entraide, c’est pour moi comprendre, assimiler et partager. Ce n’est pas, comme vous le dites si bien, obtenir un travail finalisé sans être capable de pouvoir le reproduire.

Pour faire évoluer ce tableur, il faudrait raisonner également dans l'autre sens mais je ne sais pas trop faire : voici ma demande supplémentaire qui doit être traité en première me semble t'il. Là ça commence mal, ce qui aurait été fait précédemment ne va plus? C’est là où je me suis complètement trompé. En faisant une demande, la plus simple possible, je pensais pouvoir obtenir une aide que j’aurai pu par la suite reproduire sur un cas plus complexe. Mais, à ce jour, avec les notions que j’ai en BVA, c’est difficile. C’est pour cette unique raison que j’ai reformulé en détaillant davantage ce que j’attends de l’outil. Ce qui a été fait précédemment doit etre révisé pour me satisfaire pleinement.

A votre remarque: il semblerait que dès lors que je modifie une valeur de A à E, rien ne se modifie. Or il est important que ça puisse évoluer car le nombre variera d'un jour à l'autre, d'une semaine à l'autre, je ne comprends pas, le bouton "Tirage aléatoire" a bien été fait pour régénérer une autre salve de nombres aléatoires Non? A moins que vous ne vouliez qu'un tirage au jour le jour et qui tienne compte et ne modifie pas les tirages des jours précédents. Tout fonctionne correctement dans la ventilation des taches. C’était juste une petit information où je mentionnais que je comprenais pas pourquoi quand je modifiais un chiffre dans A sur le tableau du bas, le même chiffre ne s’affichait pas encore haut

Maintenant, les employés ne travaillent plus 5 jours mais 4 jours par semaine, avec effectif réduit le lundi et le vendredi. Où sont toutes ces conditions dans la demande initiale? Je réitère mes propos, je n’ai pas été assez clair. En comprenant le raisonnement, j’aurai pensé pouvoir me l’accomoder. Il s’agit bien de salariés qui travaillent 4 jours successives (LMMJ ou MMJV). Effectif réduit le lundi et le vendredi

Est il possible de réaliser le random sur le nombre d'employés présent le jour en question, comment sait-on si l'employé est présent? c’est en cela que je disais que le raisonnement aurait dû commencer. D’abord on attribue un horaire de prise de poste et ensuite on attribue une tâche. Tous les salariés ayant un horaire, 20h ou 21h travaillent le jour en question. C’est ainsi que l’on détermine le nombre de personnes présentes. Exemple 2*20h et 4*21h un lundi, tirage sur 6 personnes

Enfin pour terminer, il faudrait que le ou les employés qui sont mentionnés "20h" soit automatiquement de tâche C. Cela signifie-t-il que la valeur 20h est déjà mise dans le tableau? Donc exclure du tirage aléatoire tous ceux qui sont marqués 20h et les marquer "C" avant tirage. si possible c’est exactement ça. Le 20h doit forcément etre de C

Toutes vos nouvelles doléances amènent de nouvelles questions, difficile dans ce cas d'être efficace et constructif.
Le problème, c'est que vous rajoutez des couches supplémentaires à chaque fois, donc le travail fait précédemment est à reprendre car ne correspond plus.
Si je reprends la demande initiale, le but était de générer des nombres aléatoires pour placer des employés sur 5 jours, ce qui a été fait jusqu'à présent correspondait bien à la demande, pour le reste avec les éléments fournis, je ne sais pas.
Tout a bien été réalisé de votre part. L’amalgame n’est dû qu’aux erreurs que j’ai commises.
Cdlt

[ARTURO83]

Bon, je pense qu'il faut tout reprendre depuis le début.

Faisons le point de ce qui est attendu:
Sur combien de semaines cela va t-il s'appliquer ?
Les heures (20h et 21h) sont placées par vos soins avant le tirage aléatoire, ce qui va déterminer les employés sollicités, le tirage aléatoire ne sert qu'à placer les valeurs A à E sur les employés sélectionnés, c'est bien ça?
Les horaires de 20h impliquent automatiquement la valeur "C"

Fournissez un tableau prêt avant le tirage

[Menhir]

j’apprends et j’évolue. Aller sur un forum d’entraide, c’est pour moi comprendre, assimiler et partager. Ce n’est pas, comme vous le dites si bien, obtenir un travail finalisé sans être capable de pouvoir le reproduire.

Ta totale passivité dans la résolution de ton problème prouve le contraire.
ARTURO83 a bien de la patience . Personnellement, devant une telle passivité, il y a longtemps que j'aurai décroché.

[VincentCA]

Bon, je pense qu'il faut tout reprendre depuis le début.

Faisons le point de ce qui est attendu:
Sur combien de semaines cela va t-il s'appliquer ? Il s'agit d'un planning étalé sur 8 semaines, à hauteur de 4 jours successifs travaillés par employé (soit du lundi au jeudi, soit du mardi au vendredi
Les heures (20h et 21h) sont placées par vos soins avant le tirage aléatoire, ce qui va déterminer les employés sollicités, le tirage aléatoire ne sert qu'à placer les valeurs A à E sur les employés sélectionnés, c'est bien ça?
Les horaires de 20h impliquent automatiquement la valeur "C"
Exactement, il s'agit bien de çà. Mon premier travaille consiste à positionner sur les employés les 20h ou 21h puis ensuite le tirage aléatoire affecte les valeurs A à E en fonction du nombre déterminé; les derniers employés restant en cellule vide. Pour l'horaire de 20h, automatiquement la valeur C doit lui être attribuée par défaut. Dans la valeur C, il y'aura toujours le même nombre que le ou les 20h positionnés.

Fournissez un tableau prêt avant le tirage

j'ai réalisé une nouvelle trame où j'ai positionné les 20h et les 21h sur 4 jours successifs. Le 20h est toujours en C.

Merci encore pour votre aide

[ARTURO83]

Bonjour,

Voilà la nouvelle mouture.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Tirage_aleatoire()
    Dim Valeur As String
    Dim Nb_Tirage As Integer, Nb_Alea As Integer
    Application.ScreenUpdating = False
    'on efface les précédents tirages
    For i = 7 To 47 Step 4
        Range(Cells(2, i), Cells(48, i)).ClearContents
    Next i
 
    'Forçage à C de tous les 20h
    For l = 2 To 48
        For c = 10 To 50 Step 4
            If Cells(l, c) = 20 Then Cells(l, c - 3) = "C"
    Next c, l
 
     For s = 2 To 44 Step 6 'pour chaque semaine
        For i = s To s + 4 'tirage pour la semaine sélectionnée
            For j = 1 To 5 'les valeurs à placer
                Valeur = Cells(1, j)
                If Valeur <> "C" Then
                    If Cells(1, j) <> 0 Then
                        Nb_Tirage = Cells(i, j)
                        For t = 1 To Nb_Tirage
                            Randomize 'Initialise le générateur de nombres aléatoires
Tirage_aleatoire:
                            'Conrôle par ligne, vérification de la présence des horaires
                            Nb_Alea = (Int(11 * Rnd) + 1)  'Nombre aléatoire entier entre 1 et 11
                            Set Empl = Rows(1).Find(Nb_Alea, LookIn:=xlValues, lookat:=xlWhole)
                            If Cells(i, Empl.Column + 3) = 21 And Cells(i, Empl.Column) = "" Then
                                Cells(i, Empl.Column) = Valeur   'on y affecte la valeur
                            Else
                                GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire
                            End If
                            'Contrôle par colonne, à partir du mercredi, vérifie que l'employé n'est pas occupé à faire 2 fois la même tâche
                            If i > 3 And Valeur <> "C" Then
                                NbLigInter = i - 1
                                Plage = Cells(s, Empl.Column).Address & ":" & Cells(i - 1, Empl.Column).Address
                                If Application.WorksheetFunction.CountIf(Range(Plage), Valeur) = 2 Then
                                    Cells(i, Empl.Column) = ""
                                    GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire
                                End If
                            End If
                        Next t
                    End If
                End If
            Next j
        Next i
    Next s
End Sub

Avec le fichier
Pièce jointe 478988

J'ai ajouter au bout de votre tableau un contrôle du résultat qui teste le nombre de valeurs placées par rapport aux données saisies dans les colonnes A à E, vous pouvez le supprimer si vous le désirez, mais il m'a permis de mettre en évidence une anomalie sur la ligne 18, seule la lettre D doit être affectée à un employé, mais on y trouve aussi un C qui n'est pas demandé en colonne C. Erreur ou pas?

Cdlt

[VincentCA]

Bonjour,

Voilà la nouvelle mouture.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Tirage_aleatoire()
    Dim Valeur As String
    Dim Nb_Tirage As Integer, Nb_Alea As Integer
    Application.ScreenUpdating = False
    'on efface les précédents tirages
    For i = 7 To 47 7 to 54Step 4
        Range(Cells(2, i), Cells(4855, i)).ClearContents
    Next i
    
    'Forçage à C de tous les 20h
    For l = 2 To 4855
        For c = 10 To 50 Step 4
            If Cells(l, c) = 20 Then Cells(l, c - 3) = "C"
    Next c, l
        
     For s = 2 To 4451Step 6 'pour chaque semaine
        For i = s To s + 4 'tirage pour la semaine sélectionnée
            For j = 1 To 5 'les valeurs à placer
                Valeur = Cells(1, j)
                If Valeur <> "C" Then
                    If Cells(1, j) <> 0 Then
                        Nb_Tirage = Cells(i, j)
                        For t = 1 To Nb_Tirage
                            Randomize 'Initialise le générateur de nombres aléatoires
Tirage_aleatoire:
                            'Conrôle par ligne, vérification de la présence des horaires
                            Nb_Alea = (Int(11 * Rnd) + 1)  'Nombre aléatoire entier entre 1 et 11
                            Set Empl = Rows(1).Find(Nb_Alea, LookIn:=xlValues, lookat:=xlWhole)
                            If Cells(i, Empl.Column + 3) = 21 And Cells(i, Empl.Column) = "" Then
                                Cells(i, Empl.Column) = Valeur   'on y affecte la valeur
                            Else
                                GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire
                            End If
                            'Contrôle par colonne, à partir du mercredi, vérifie que l'employé n'est pas occupé à faire 2 fois la même tâche
                            If i > 3 And Valeur <> "C" Then
                                NbLigInter = i - 1
                                Plage = Cells(s, Empl.Column).Address & ":" & Cells(i - 1, Empl.Column).Address
                                If Application.WorksheetFunction.CountIf(Range(Plage), Valeur) = 2 Then
                                    Cells(i, Empl.Column) = ""
                                    GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire
                                End If
                            End If
                        Next t
                    End If
                End If
            Next j
        Next i
    Next s
End Sub

Avec le fichier
Pièce jointe 478988

J'ai ajouter au bout de votre tableau un contrôle du résultat qui teste le nombre de valeurs placées par rapport aux données saisies dans les colonnes A à E, vous pouvez le supprimer si vous le désirez, mais il m'a permis de mettre en évidence une anomalie sur la ligne 18, seule la lettre D doit être affectée à un employé, mais on y trouve aussi un C qui n'est pas demandé en colonne C. Erreur ou pas? oui il s’agissait d’une erreur, le code fonctionne très bien par rapport à la demande et je vous en remercie énormément. J’ai juste une petite interrogation que je ne suis pas arrivé à résoudre. Quand l’employe est de 20h, il est forcément C. Mais si la valeur de la colonne C est > aux 20h, ça ne fonctionne pas. Si par exemple j’ai une personne de 20h et une valeur de C=2, l’aleatoire ne tire pas un deuxième C parmis les 21h.

Je me suis aperçu que ma demande était encore approximative car sur le tableau fourni, je fourni 8 semaines du lundi au vendredi mais le week end n’est que sur une ligne or il en faut deux pour samedi dimanche.
Cela change du coup la position de toutes les lignes si j’insere des dimanches. J’ai réfléchi à la modification du code et vous en fais part en rouge si dessus. Ça semble fonctionner quand je teste mais ça tire pas la ligne 55. Ça s’arrete a la 54

Cdlt

[ARTURO83]

Bonjour,

Nouvelle version

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
    Dim Valeur As String
    Dim Nb_Tirage As Integer, Nb_Alea As Integer
    Dim i As Long, j As Long, l As Long, c As Long, t As Long, s As Long, Nb_de_C_place As Long, NbVal As Long
    Dim Liste As String
    Dim Deb As Date
 
Sub Tirage_aleatoire()
    Application.ScreenUpdating = False
    'on efface les précédents tirages
    For i = 7 To 47 Step 4
        Range(Cells(2, i), Cells(55, i)).ClearContents
    Next i
 
    'Forçage à C de tous les 20h
    For l = 2 To 55
        For c = 10 To 50 Step 4
            If Cells(l, c) = 20 Then Cells(l, c - 3) = "C"
    Next c, l
 
Nouveau_Tirage:
    Randomize 'Initialise le générateur de nombres aléatoires
     For s = 2 To 51 Step 7 'pour chaque semaine
        For i = s To s + 4 'tirage pour la semaine sélectionné
             For j = 1 To 5 'les valeurs à placer
                Valeur = Cells(1, j)
                If Valeur <> "C" Then
                    If Cells(1, j) <> 0 Then
                        Nb_Tirage = Cells(i, j)
                        Tirage
                    End If
                Else
                    Nb_de_C_place = Application.WorksheetFunction.CountIf(Range(Cells(i, "G").Address & ":" & Cells(i, "AX").Address), "C")
                    If Cells(1, j) > Nb_de_C_place Then
                        Nb_Tirage = Cells(i, j) - Nb_de_C_place
                        If Nb_Tirage > 0 Then Tirage
                    End If
                End If
            Next j
        Next i
    Next s
End Sub
 
Sub Tirage()
    Echec = False
    For t = 1 To Nb_Tirage
        Deb = Time
Tirage_aleatoire:
        If Time > Deb + 1 / 86400 Then 'si le tirage est impossible au bout d'une seconde, on recommence tout
            Tirage_aleatoire
            Exit Sub
        End If
        'Conrôle par ligne, vérification de la présence des horaires
        Nb_Alea = (Int(11 * Rnd) + 1)  'Nombre aléatoire entier entre 1 et 11
        Set Empl = Rows(1).Find(Nb_Alea, LookIn:=xlValues, lookat:=xlWhole)
        If Cells(i, Empl.Column + 3) = 21 And Cells(i, Empl.Column) = "" Then
            Cells(i, Empl.Column) = Valeur   'on y affecte la valeur
        Else
            GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire
        End If
        'Contrôle par colonne, à partir du mercredi, vérifie que l'employé n'est pas occupé à faire 2 fois la même tâche
        If i > 3 And Cells(i, Empl.Column + 3) = 21 Then
            NbLigInter = i - 1
            Plage = Cells(s, Empl.Column).Address & ":" & Cells(i - 1, Empl.Column).Address
            If Application.WorksheetFunction.CountIf(Range(Plage), Valeur) = 2 Then
                Cells(i, Empl.Column) = ""
                GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire
            End If
        End If
    Next t
End Sub

avec le fichier
Pièce jointe 479299

Cdlt

[VincentCA]

Bonjour Arturo83,

J’etais en déplacement depuis quelques semaines et n’ai pas eu le temps de vous remercier.
Je tenais très sincèrement à vous remercier pour tout le travail bénévole que vous avez réalisé pour m’aider dans la résolution de mon problème.
J’essaie désormais de décrypter avec beaucoup d’attention le code pour le faire évoluer mais c’est un travail qui n’est pas à la portée de tous, tellement les lignes de codes sont nombreuses et complexes.
J’aimerais faire évoluer le tableau en ajoutant 2 critères supplémentaires mais j’ai encore beaucoup de mal.
Pourriez vous, à défaut de me l’écrire, me donner quelques lignes directrice pour que je puisse pour les colonnes comportant les critères A et E remplies qu’elles n’apparaissent qu’une fois par employé et par semaine. Et créer une boucle pour que si la premiere semaine, il n’a pas eu le critère A par exemple, il l’ait en deuxième semaine. Idem E. Etc ... jusqu’au 8 semaines.

Ex
Semaine 1
l’employé 1 peut avoir le A le lundi, le E le vendredi
Pendant que l’employé 2 aura le A le mardi, le E le jeudi
Et l’employé 3 aurait le A le mercredi
Et l’employé 8 aurait le A le jeudi
Et l’employé 6 le A le vendredi.
L’employé 5 aurait que le E le mercredi
L’employé 4 aurait que le E le mardi
L’employé 7 aurait que le E le lundi.

Semaine2
Un autre tirage aléatoire ou certains employés peuvent avoir une fois le A , une fois le E dans la même semaine et d’autres employés que le A ou que le E sans dépasser une fois de chaque.

Jusqu’à présent, le seule critère du code était que chaque critère ne soit pas plus de 2 fois par semaine mais je me suis aperçu que le A et le E ne pouvait pas être appliqué plus d’une fois par semaine. J’ai essayé de créer un code en m’aidant de celui existant pour dire «*si le critère A ou E est déjà sorti (=1), ne pas ressortir sur une même semaine, c’est OK*» mais en vain.

Merci encore,

[VincentCA]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'Contrôle par colonne, à partir du mardi, vérifie que l'employé n'est pas occupé à faire 2 fois la même tâche A
        If i > 2 And Cells(i, Empl.Column + 2) = 21 Then
            NbLigInter = i - 1
            Plage = Cells(s, Empl.Column).Address & ":" & Cells(i - 1, Empl.Column).Address
            If Application.WorksheetFunction.CountIf(Range(Plage), «*A*») = 2 Then
                Cells(i, Empl.Column) = ""
                GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire
 
 
  'Contrôle par colonne, à partir du mardi, vérifie que l'employé n'est pas occupé à faire 2 fois la même tâche E
        If i > 2 And Cells(i, Empl.Column + 2) = 21 Then
            NbLigInter = i - 1
            Plage = Cells(s, Empl.Column).Address & ":" & Cells(i - 1, Empl.Column).Address
            If Application.WorksheetFunction.CountIf(Range(Plage), «*E») = 2 Then
                Cells(i, Empl.Column) = ""
                GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire

[VincentCA]

Bonjour @ARTURO83,

Pourriez vous me dire si le code pourrait fonctionner ?
Merci d'avance,