Discussion :

[Alaindhu]

Bonjour à tous,

Après quelques heures de bricolages et de recherches, je me permets de solliciter votre aide sur un de mes fichiers. J'ai réalisé deux codes (un qui marche par la grace de l'enregistreur... pour balayer toutes les lignes et l'autre que j'ai tenté en freestyle qui ne marche pas) ==> Je les mets à la fin du post.

En gros, j'ai trois onglets, un "synthèse" avec les disponibilités des équipes A,B,C,D,E,F,G par dates (sachant que deux équipes peuvent être dispo le même jour), un "plan" qui définit les besoins de stages pour chaque personne à planifier et un "planning" où je souhaite ramener les disponibilités de chaque personne, en fonction de son roulement et de son équipe et qu'Excel me propose la meilleure répartition par stage en fonction du nombre maximum de participation par stage (ligne 2 de l'onglet planning)

Cela me parait être une montagne, avez vous une idée sur la meilleure manière de s'y prendre?

Merci de votre aide!
ci après le fichier sans macros:
Gestion des roulements_TEST - Copie.xlsx


Ci-dessous mes "bricolages"...:

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
Dim I As Integer
I = 0
 
Worksheets("SYNTHESE").Select
Worksheets("SYNTHESE").Range("A1048576").Select
Selection.End(xlUp).Select
 
 
 
If Range("B379").Value = Worksheets("PLAN").Range("C3").Value Then
Worksheets("PLAN").Range("E3").Value = "X"
End If
 
While ActiveCell <> Range("A3")
For I = 1 To 3
 
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
I = I + 1
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
I = I + 1
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
I = I + 1
Next
 
I = 0
 
ActiveCell.Offset(rowOffset:=-1, columnOffset:=-3).Activate
 
Wend
 
End Sub

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
Option Explicit
 
Sub TEST()
 
'1 recherche du nombre de personne
Dim I As Long
Dim ligne As Long
Dim col As Long
 
I = 5
While Sheets("SYNTHESE").Cells(I, 1).Text <> ""
I = I + 1
Wend
 
ligne = 5
col = 2
 
 
While Sheets("SYNTHESE").Cells(5, col).Text <> "" 'balaye les lignes
        While ligne < I 'balaye les colonnes
 
        '**********************voir si partie du dessous fonctionne*******************************
            If Sheets("SYNTHESE").Cells(ligne, col).Value = Sheets("PLAN").Cells(col - 0, I) Then
                    Sheets("PLAN").Cells(col - 0, I) = Sheets("SYNTHESE").Cells(ligne, 3).Text
                End If
        '*****************************************************************************************
 
        ligne = ligne + 1
        Wend
        col = col + 1
        ligne = 4
Wend
 
End Sub

comment faire une fois que la boucle est créé pour que les infos contenues dans l'onglet synthèse alimente l'onglet planning?

[Marc-L]

Par exemple via Range.Copy en utilisant son paramètre Destination, voir l'aide VBA interne …

[Alaindhu]

Bonjour,

merci pour votre retour... J'ai avancé et une partie de mon problème est résolu.
Je parviens:
1- dans l'onglet PLANNING à récupérer les disponibilités des personnes pour chaque date
2- dans l'onglet CRITERE à récupérer les dates auxquelles je peux planifier des événements car j'ai suffisamment de personnes dispo

mais pour la suite je bloque...
Chaque personne (donc chaque matricule) a un ou plusieurs besoins sur des stages (STAGES1, STAGES2, etc...) et j'ai besoin qu’en fonction du nombre total de besoin par formation (stage) et des disponibilités de chaque personne, je puisse trouver la meilleure combinaison pour organiser des sessions de stage

En gros par ex:
- M. Dupont à besoin de suivre le stage 1 et est disponible le 24/05/2017 et le 25/05/2017
- MME TARTANPION à besoin de suivre le stage 1 et le stage 2 et est disponible le 24/05/2017
- M. JEAN à besoin de suivre le stage 2 et est disponible le 24/05/2017

Je dois avoir minimum 3 personnes pour organiser le stage 1 et 3 personnes minimum pour le stage 2
==> j'organise donc le stage 2 le 24/05/2017

Avez-vous une idée svp?
ci-joint le fichier sans macros:
test roulement.xlsx


Et le code pour ceux que cela intéresse...:

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
Option Explicit
 
Sub reportingPlanning()
 
Dim ligne As Long
Dim equipe As String
Dim Numroulement As Byte
Dim stage As String
Dim DateStage As Range
Dim cellule As Range
Dim CelluleResultat As Range
 
Application.ScreenUpdating = False
 
Set DateStage = Range(Range("E2"), Range("E2").End(xlToRight))
 
For Each cellule In DateStage
 
    Sheets("SYNTHESE").Select
    Columns("A:A").Select
    On Error GoTo PasDeDate
    Set CelluleResultat = Selection.Find(What:=CDate(cellule.Value), After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
 
    Sheets("PLANNING").Select
    For ligne = 4 To Range("Tplanning").Rows.Count
        equipe = Cells(ligne, 2)
        Numroulement = CByte(Right(Cells(ligne, 3), 1))
        stage = Cells(ligne, 4)
 
        If Not IsError(CelluleResultat.Offset(0, Numroulement)) Then
          If InStr(1, CelluleResultat.Offset(0, Numroulement), equipe) > 0 Then
            Cells(ligne, cellule.Column) = "X"
          End If
        End If
    Next
PasDeDate:
Next
 
Application.ScreenUpdating = True
 
MsgBox "Reporting terminé"
End Sub
 
 
Sub ReportingCritere()
 
Dim plageFormation As Range
Dim plageStage As Range
Dim cellule As Range
Dim mini As Integer
Dim maxi As Integer
Dim i As Integer
Dim j As Long
 
Application.ScreenUpdating = False
 
j = 3
 
Sheets("CRITERE").Select
Set plageFormation = Range(Range("A2"), Range("A2").End(xlDown))
 
For Each cellule In plageFormation
    mini = cellule.Offset(0, 1)
    maxi = cellule.Offset(0, 2)
    Sheets("PLANNING").Select
    ActiveSheet.ListObjects("Tplanning").Range.AutoFilter Field:=4, Criteria1:=cellule.Value
 
    Set plageStage = Range(Range("D3"), Range("D3").End(xlDown)).SpecialCells(xlCellTypeVisible)
 
    For i = 1 To Range("Tplanning").Columns.Count - 4
        If Application.WorksheetFunction.CountA(plageStage.Offset(0, i)) >= mini And _
           Application.WorksheetFunction.CountA(plageStage.Offset(0, i)) <= maxi Then
 
          cellule.Offset(0, j).Value = Cells(2, plageStage.Offset(0, i).Column)
          j = j + 1
        End If
    Next
    j = 3
Next
 
ActiveSheet.ShowAllData
 
Application.ScreenUpdating = True
 
MsgBox "Traitement terminé"
End Sub