Discussion :

[ARTURO83]

Bonjour,

Ce que vous demandez nécessite d'aborder le sujet avec une autre analyse entraînant encore des modifications importantes voire de tout reprendre depuis le début.
je regarderai, mais je ne garantis rien.

Cdlt

[VincentCA]

Je comprends! Moi je pensais que les lignes de codes pouvaient être similaires à celles utilisées pour la non répétition de 2 fois une même tache par semaine. Sur le principe, je pensais avoir compris ! Mais c’est complexe

[ARTURO83]

Bonjour,

Dois-je en conclure que dans le remplissage du tableau (colonne A à E) il ne peut y avoir qu'un seul A et qu'un seul E par jour affectés à un agent différent, et on procède à un décalage à chaque semaine?
En fait, si l'on fixe les C (lorsque les heures=20), puis les A et les E, Seuls les C et D sont affectés aléatoirement. Est-ce bien cela?

Le sujet devenant de plus en plus complexe, pourriez-vous fournir un tableau fait manuellement reprenant toutes ces questions afin que je puisse me faire une idée du résultat attendu?

Cdlt

[Menhir]

Pourriez vous me dire si le code pourrait fonctionner ?

Tu es le mieux placé pour avoir la réponse à cette question : teste-le et tu sauras s'il fonctionne.

[VincentCA]

Bonjour,

J'ai fais un nouveau tableau avec les résultats simulés pour 8 semaines sur 11 employés.

Dans le remplissage du tableau (colonne A à E) il ne peut y avoir qu'un seul A et qu'un seul D par jour affectés à un agent différent et on procède à un décalage à chaque semaine
Les C sont fixés en priorité sur les 20 mais si le nombre de C affectés >20 positionnés, alors C affectés sur les autres employés
Pour B, C, E maxi 2 fois par employés et par semaine comme la demande initiale où à partir du mercredi, cette donnée était vérifiée.
Si valeur = 0 dans une colonne ABCDE, alors pas de tâche attribuée le jour en question. Ex si un lundi (ligne 2), tâche D et E=0, alors pas de D et E sur les x employés présents le lundi.

Sur ma simulation, les colonnes ABCDE comptabilisent le total des tâches par jour mais en pratique, je remplirai le nombre de valeurs souhaitées par tache et le macro dispatchera automatiquement. Cela ne change pas par rapport au dernier macro que vous m'avez fourni.

[VincentCA]

Bonjour ARTURO83,

J’espère juste que le tableau aura pu vous permettre de comprendre les besoins...

[ARTURO83]

Bonjour,

Je ne vous ai pas oublié, seulement comme le problème est un peu casse-tête, je n'y travaille qu'au fur et à mesure que me vient les idées sur la façon de l'aborder. Soyez patient.

Question: le dernier fichier que vous avez déposé est-il le bon? parce que vous avez encore changé les emplacements par rapport au précédent.

Cdlt

[VincentCA]

Bonjour,

Effectivement, je viens de m’apercevoir que les emplacements ont été changés. Il s’agit du fait que je re modélise par la suite le tableau pour la mise en forme.
En vous envoyant ce dernier planning, j’ai pris la trame finale.
Toutefois, le fonctionnement reste similaire.
Sur le planning 5, la premiere colonne de chaque employé était la tâche et la quatrième colonne l’horaire alors que dans le dernier planning envoyé, la premiere colonne est l’horaire et la deuxième colonne la tâche pour un même employé.
Si vous le voulez bien, je propose que l’on reste sur le modèle du planning5 pour ne pas avoir à rechanger tout le code VBA. Je m’adapterai par la suite.
Pour les taches, l’ordre est identique.

Pour l’instant, je réalise tous mes planning en mode non automatique, c’est moi qui place et qui compte simplement sur un excel.

Merci encore pour votre aide généreuse,

[ARTURO83]

Bonjour,

Si vous le voulez bien, je propose que l’on reste sur le modèle du planning5 pour ne pas avoir à rechanger tout le code VBA. Je m’adapterai par la suite.
TROP tard, j'ai déjà adapté les modifications par rapport au dernier planning, dois-je en rester là ou bien revenir à l'arrière?

Cdlt

[VincentCA]

Houlà !!! Surtout pas.
Si le travail est deja entamé, pas de retour en arrière.
J’adapterai sans aucun problème.
Vous en faites déjà énormément pour moi, ça suffit ainsi...
Merci

[ARTURO83]

Bonjour,

Voilà le fichier
Pièce jointe 489296

Et 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
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
Option Compare Text
Option Explicit
 
Dim Valeur As String
Dim Nb_Tirage As Integer, Nb_Alea As Integer
Dim i As Long, j As Long, NbVal As Long
Dim L As Byte, C As Byte, T As Byte, s As Byte, Empl As Byte
Dim Liste As String, Lettre As String, x
Dim Deb As Date
Dim Nb_de_C_place As Long, Nb_de_21 As Long
Dim PL_Sem As String, DebX As String
 
Sub Tirage_aleatoire()
    Application.ScreenUpdating = False
    'on efface les précédents tirages
    Range("H2:H55,L2:L55,P2:P55,T2:T55,X2:X55,AB2:AB55,AF2:AF55,AJ2:AJ55,AN2:AN55,AR2:AR55,AV2:AV55").ClearContents
 
    'Forçage à C de tous les 20h
    With Range("G2:AX55")
        Set x = .Find(20, LookIn:=xlValues)
        If Not x Is Nothing Then
                DebX = x.Address
            Do
                Cells(x.Row, x.Column + 1) = "C"
                Set x = .FindNext(x)
            Loop While Not x Is Nothing And x.Address <> DebX
        End If
    End With
 
    Randomize 'Initialise le générateur de nombres aléatoires
    For L = 2 To 55 'traitement de chaque jour sur les 8 semaines
        If Cells(L, "A").Interior.ColorIndex = xlNone Then ' si c'est un jour ouvré
            For C = 1 To 4 Step 3 'Traitement pour chaque lettre de A et D
                Lettre = Cells(1, C)
                Nb_Tirage = Cells(L, C)
                If Nb_Tirage <> 0 Then Tirage
            Next C
            For C = 2 To 3 'Traitement pour chaque lettre de B et C
                Lettre = Cells(1, C)
                If C = 3 Then 'si c'est la lettre C à tester,
                    Nb_Tirage = Cells(L, C) - Application.WorksheetFunction.CountIf(Range(Cells(L, "G"), Cells(L, "AX")), 20)
                Else
                    Nb_Tirage = Cells(L, C)
                End If
                If Nb_Tirage <> 0 Then Tirage
            Next C
            C = 5 'Traitement pour chaque lettre de B
            Lettre = Cells(1, C)
            Nb_Tirage = Cells(L, C)
            If Nb_Tirage <> 0 Then Tirage
        End If
    Next L
 
Nouveau_Tirage:
End Sub
 
Sub Tirage()
    For T = 1 To Nb_Tirage
Tirage_aleatoire:
        Deb = Time
        If Time > Deb + 1 / 86400 Then 'si le tirage est impossible au bout d'une seconde, on recommence tout
            Tirage_aleatoire 'on relance le programme principal
            Exit Sub
        End If
        'Contrô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 (Nombre d'employés)
        Empl = (4 * (Nb_Alea - 1)) + 7
 
        'Déterminer la plage de la semaine traitée (PL_Sem= plage couverte du lundi au dimanche dans la colonne de l'employé sélectionné)
        Select Case L
            Case Is < 9 'Semaine 1
                PL_Sem = Range(Cells(2, Empl + 1), Cells(8, Empl + 1)).Address
            Case Is < 16 'Semaine 2
                PL_Sem = Range(Cells(9, Empl + 1), Cells(15, Empl + 1)).Address
            Case Is < 23 'Semaine 3
                PL_Sem = Range(Cells(16, Empl + 1), Cells(22, Empl + 1)).Address
            Case Is < 30 'Semaine 4
                PL_Sem = Range(Cells(23, Empl + 1), Cells(29, Empl + 1)).Address
            Case Is < 37 'Semaine 5
                PL_Sem = Range(Cells(30, Empl + 1), Cells(36, Empl + 1)).Address
            Case Is < 44 'Semaine 6
                PL_Sem = Range(Cells(37, Empl + 1), Cells(43, Empl + 1)).Address
            Case Is < 51 'Semaine 7
                PL_Sem = Range(Cells(44, Empl + 1), Cells(50, Empl + 1)).Address
            Case Is < 56 'Semaine 8
                PL_Sem = Range(Cells(51, Empl + 1), Cells(55, Empl + 1)).Address
        End Select
 
        Cells(L, Empl).Select
        If Cells(L, Empl) = 21 And Cells(L, Empl + 1) = "" Then
        '1er contrôle, on vérifie que l'on ne dépasse pas le nombre autorisé dans la même semaine pour le même employé
            If Lettre = "A" And Application.WorksheetFunction.CountIf(Range(PL_Sem), "A") = 0 Or _
                Lettre = "D" And Application.WorksheetFunction.CountIf(Range(PL_Sem), "D") = 0 Or _
                Lettre = "B" And Application.WorksheetFunction.CountIf(Range(PL_Sem), "B") < 2 Or _
                Lettre = "C" And Application.WorksheetFunction.CountIf(Range(PL_Sem), "C") < 2 Or _
                Lettre = "E" And Application.WorksheetFunction.CountIf(Range(PL_Sem), "E") < 2 Then
                GoTo DeuxiemeControle
            Else
                GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire
            End If
DeuxiemeControle:
        '2ème contrôle, à partir de la 2ème semaine, on vérifie que la même lettre  A ou D ne se reproduise pas le même jour de la semaine précédente pour le même employé
            If L > 8 Then
                If Lettre = "A" And Cells(L - 7, Empl) = "A" Or Lettre = "D" And Cells(L - 7, Empl) = "D" Then
                    GoTo Tirage_aleatoire
                Else
                    Cells(L, Empl + 1) = Lettre
                End If
            Else
                Cells(L, Empl + 1) = Lettre
            End If
        Else
            GoTo Tirage_aleatoire 'sinon on refait un tirage aléatoire
        End If
    Next T
End Sub

Cdlt

[VincentCA]

Bonjour @Arturo83, mes fonctions ayant évolué, j'aurai besoin d'un nouveau coup de pouce. Accepteriez vous de m'aider s'il vous plaît ? Merci d'avance

[ARTURO83]

Bonjour,

mes fonctions ayant évolué, j'aurai besoin d'un nouveau coup de pouce. Accepteriez vous de m'aider s'il vous plaît ? Merci d'avance

Bien sûr, mais je ne suis pas tout seul à intervenir sur le forum et il serait souhaitable et préférable que vous fassiez votre demande dans un nouveau post, vous obtiendrez ainsi le plus de réponses possibles avec des solutions aussi diverses que variées pour arriver au résultat souhaité.

Cdlt

[VincentCA]

Merci pour votre réponse !
J'ai rédigé un nouveau post afin de pouvoir être aidé.