Discussion :

[elfyx]

Bonjour à tous,

Je travaille sur la réalisation d'un fichier de suivi (Suivi.xlsx) contenant un planning de l'année et les ressources de mon équipe.
Toutes les semaines, un fichier portant le numéro de la semaine S0x_Planification.xlsx est généré provenant de base de données interne à l'entreprise.

Dans les fichiers S0x_Planification.xlsx se trouvent les informations des opérations faites par les ressources avec les informations suivantes : Date, Numéro Opération, Auteur (correspondant à une ressource) et une Description.



Dans mon fichier de Suivi, je souhaiterai mettre en forme certaines de ces informations. Mon fichier ressemble à cela :



Je souhaite récupérer l'information du NumOP et la Description pour chaque ressource et pour chaque jour de la semaine.
Le NumOP serait mis dans la cellule et la Description serait mise en commentaire de la même cellule.

Cela fait plusieurs jours que j'ai commencé à travailler sur le sujet et voici mon avancement. Je suis du coup très rapidement arriver sous VBA pour avancer.

Ma fonction ne traite actuellement que les cases K13 à K16 (pour démarrer j'avais pas besoin de plus vu que c'est pas totalement fonctionnel).
Je vais chercher les informations dans le classeur S0X qui est fermé (d'où l'utilisation du chemin complet dans la macro dans VLOOKUP).
Une fois que j'ai trouvé ma ligne, je commence par mettre le nom de la ressource dans la cellule, puis je mets la description dans la cellule à la place, puis je mets le contenu de la cellule en commentaire (c'est à dire la description) puis je mets enfin le NumOP dans la cellule.
Si un jour de la semaine n'existe pas, alors je mets la celulle vide.


J'arrive donc à ce résultat.





Le problème de la fonction VLOOKUP dans mon cas est qu'elle s'arrête à la première rencontre de la date recherchée. Du coup, si je prends en exemple le suivi de la ressource 7, la macro me remonte bien qu'il a une opération le 07/01/2019 car c'est la première itération de la date, mais elle ne remonte pas l'opération du 08/01/2019 car la première itération est avec la ressource 3.

En plus de cela, je rencontre un souci sur la possibilité qu'une ressource réalisent plusieurs opérations le même jour dont je ne trouve pas la solution actuellement.

Une fois que cela sera fonctionnel, il me restera le fait de réaliser la macro pour toutes les colonnes (c'est à dire chacune de mes ressources). Et également comment rendre dynamique cette ligne de ma macro en fonction de la colonne où je me trouve : If ActiveCell.Value = "R7" Then ==> Remplacer "R7" par une valeur dynamique.


Ma fonction se trouve ci-dessous.

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
 
 
Sub Worksheet_Change()
 
 
For Each Cell In Worksheets("2019").Range("K13:K16").Cells
 
    Cell.Select
    madate = Range("B" & Cell.Row)
    Chemin = "C:\Users\xxx\Desktop\Demande"
    Fichier = "_Planification.xlsx"
    NomTableRecherche = "WF OPI" ' nom du champ
    PlageRecherche = "R2C3:R21C13" 'plage
    NumSem = Format(madate, "ww", vbMonday, vbFirstFourDays) 'recup du num semaine pour concatener le chemin du fichier
 
    If Dir(Chemin & "\S0" & NumSem & Fichier) <> "" Then
 
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(TEXT(RC[-9],""jj/mm/aaaa"")," & "'" & Chemin & "\[S0" & NumSem & Fichier & "]" & NomTableRecherche & "'!" & PlageRecherche & ",9,FALSE)"
        If ActiveCell.Value <> "#N/A" Then
            If ActiveCell.Value = "R7" Then
                ActiveCell.FormulaR1C1 = _
                    "=VLOOKUP(TEXT(RC[-9],""jj/mm/aaaa"")," & "'" & Chemin & "\[S0" & NumSem & Fichier & "]" & NomTableRecherche & "'!" & PlageRecherche & ",11,FALSE)"
                If ActiveCell.Comment Is Nothing Then ActiveCell.AddComment
                    ActiveCell.Comment.Text Text:=Sheets("2019").Cells(Cell.Row, Cell.Column).Value
                    'ActiveCell.Shape.TextFrame.AutoSize = True
                    ActiveCell.Comment.Shape.Width = 300
                    ActiveCell.Comment.Shape.Height = 100
                    ActiveCell.FormulaR1C1 = _
                        "=VLOOKUP(TEXT(RC[-9],""jj/mm/aaaa"")," & "'" & Chemin & "\[S0" & NumSem & Fichier & "]" & NomTableRecherche & "'!" & PlageRecherche & ",3,FALSE)"
 
            Else
                ActiveCell.Value = ""
            End If
        Else
            ActiveCell.Value = ""
        End If
 
    Else
      MsgBox "fichier inconnu"
 End If
Next
End Sub

Je suis bien évidemment preneur de vos idées, il y a surement des choses auxquelles je ne pense pas et que je ne connais pas, je suis à votre écoute

[ARTURO83]

Bonjour,

Un exemple à adapter

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
Sub Transfert()
    Application.ScreenUpdating = False
    Set ShSOx = Sheets("SOx_Planification")
    Set ShPlan = Sheets("Planning")
 
    DerLig = ShSOx.[K10000].End(xlUp).Row
    ReDim Auteur(DerLig - 1) As String
    ReDim vDate(DerLig - 1) As Long
    ReDim NumOp(DerLig - 1) As String
    ReDim Descript(DerLig - 1) As String
 
    'Relevé des infos
    For i = 2 To DerLig - 1
        Auteur(i) = ShSOx.Cells(i, "K")
        vDate(i) = ShSOx.Cells(i, "C") * 1
        NumOp(i) = ShSOx.Cells(i, "E")
        Descript(i) = ShSOx.Cells(i, "M")
    Next i
 
    'Restitution des infos dans le planning
    'Conversion de la date en numérique
    Columns("B:B").NumberFormat = "0"
    ShPlan.Select
    For i = 2 To DerLig - 1
        'on recherche l'auteur
        Set Col_R = ShPlan.Rows(3).Find(Auteur(i), LookIn:=xlValues)
        If Col_R Is Nothing Then
            MsgBox "Auteur introuvable"
            Exit Sub
        End If
        'On recherche la date
        Set Lig_D = ShPlan.Columns(2).Find(vDate(i), LookIn:=xlValues)
        If Lig_D Is Nothing Then
            MsgBox "Date introuvable"
            Exit Sub
        End If
 
        'Ajout de l'opérateur
        ShPlan.Cells(Lig_D.Row, Col_R.Column) = Cells(Lig_D.Row, Col_R.Column) & Chr(10) & NumOp(i)
 
        'Ajout du commentaire
        If ShPlan.Cells(Lig_D.Row, Col_R.Column).Comment Is Nothing Then
            With ShPlan.Cells(Lig_D.Row, Col_R.Column)
                .AddComment
                .Comment.Text Text:=Descript(i)
            End With
        Else
            CommentExist = ShPlan.Cells(Lig_D.Row, Col_R.Column).NoteText
            ShPlan.Cells(Lig_D.Row, Col_R.Column).Comment.Text Text:=CommentExist & Chr(10) & Descript(i)
        End If
        ShPlan.Cells(Lig_D.Row, Col_R.Column).Comment.Visible = False
    Next i
 
    'Remise au format date de la colonne B
    Columns("B:B").NumberFormat = "ddd dd/mmm/yyyy"
End Sub

Avec un fichier exemple:
Allez sur la feuille "Planning" et cliquez sur le bouton "Importer les données"
https://mon-partage.fr/f/ySXBwOnc/

Cdlt

[elfyx]

Bonjour,

Merci ARTURO83.
J'ai testé ton code et effectivement ça ressemble très fortement à ce que je veux faire.

Par contre, est ce qu'il existe un moyen pour que la feuille SOx_Planification soit alimenter par mes fichiers générés chaque semaine qui sont :
S01_Planification
S02_Planfication
S03_Planification
Etc..

Un troisième bouton par exemple qui permettrait d'aller populer la feuille en concaténant toutes les lignes dans l'ordre S01 à S03 et plus bien sûr jusqu'à S52 même si les fichiers n'existent pas encore

Merci encore d'avoir pris le temps de me partager cette macro, je l'analyse encore, il y a des choses que je découvre dedans.

[jpvba]

Bonjour Elfyx,


Voici 2 fonctions que j'utilise énormément. Elles ont été élaborés grace a des gens du forum qui ont répondu à un post antérieur.

LA première va répété dans la dite cellule le nombre de fois que la meme valeur ce répete. Par exemple si dans la plage à chercher il y a 4 fois le mot chameau et c'est chameau que l'on veut trouver, chameau va etre répéter 4 fois

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
Function rmult(valeurachercher As Variant, plageachercher As Range, numcolonne As Long) As Variant
    Dim u As Variant
    Dim nb As Long
    Dim boucle As Long
 
    For boucle = 1 To plageachercher.Rows.Count
 
        If plageachercher(boucle, 1) = valeurachercher Then
            u = u & plageachercher(boucle, numcolonne) & Chr(10)
            nb = nb + 1
        End If
 
    Next boucle
 
    If Right$(u, 1) = Chr(10) Then u = Left$(u, Len(u) - 1)
 
    rmult = u
 
End Function

La seconde est la même sauf que le mot chameau apparaît seulement 1 fois

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
Function rmultUnique(valeurachercher As Variant, plageachercher As Range, numcolonne As Long) As String
    Dim u As Variant
    Dim nb As Long
    Dim boucle As Long
    Dim tabval() As Variant
    ReDim tabval(plageachercher.Rows.Count)
 
    nb = 1
    u = ""
 
    For boucle = 1 To plageachercher.Rows.Count
        If plageachercher(boucle, 1) = valeurachercher Then
            tabval(nb) = plageachercher(boucle, numcolonne)
            nb = nb + 1
        End If
    Next boucle
 
 
    For i = 1 To nb - 1
        For j = i + 1 To nb - 1
            If tabval(i) = tabval(j) Then tabval(j) = ""
        Next j
    Next i
 
    For i = 1 To nb
        If tabval(i) <> "" Then u = u & tabval(i) & Chr(10)
 
    Next i
 
    If Right$(u, 1) = Chr(10) Then u = Left$(u, Len(u) - 1)
 
    rmultUnique = u
 
End Function

en espérant également que cela peut être utile

[ARTURO83]

Bonjour,

Pour récupérer les semaines, sur la feuille "Importation des semaines", saisissez le chemin complet où se trouvent les fichiers-semaines, puis cliquez sur le bouton. Toutes les données sont recopiées dans la feuille "Sox_Planification"
Remarque:, j'ai considéré que dans les fichiers semaines, les données commençaient à la ligne 2, la ligne 1 étant réservé aux titres de colonnes.

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
Sub Recup_Semaines()
    Dim FichiersAOuvrir
    Dim i As Integer
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error GoTo Erreur
    CeClasseur = ThisWorkbook.Name
    Sheets("SOx_Planification").Select
    Range("A2:M" & [C10000].End(xlUp).Row).ClearContents
    For i = 1 To 52
        N = Format(i, "00")
        Chemin = Sheets("Importation_des_donnees").[C5] & "\"
        Workbooks.Open FileName:=Chemin & "S" & N & "_Planification"
        Classeur_Sem = ActiveWorkbook.Name
        Range("A2:M" & [C10000].End(xlUp).Row).Copy
        Windows(CeClasseur).Activate
        Cells([C10000].End(xlUp).Row + 1, "A").Select
        ActiveSheet.Paste
        Windows(Classeur_Sem).Close
    Next i
    Exit Sub
Erreur:
End Sub

Avec le fichier
https://mon-partage.fr/f/dFdbOB1y/

Cdlt

[elfyx]

Merci pour cette seconde aide.
J'arrive à récupérer les infos des fichiers S0x_Planification, mais une fois que je veux faire la macro Transfert, il me met une incompatibilité de type sur la ligne suivante :

Code :

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

 vDate(i) = ShSOx.Cells(i, "C") * 1

J'ai regardé la colonne C après import des données et le type est Texte, je pense que cela ne correspond à ce qui est attendu.
Je cherche de mon côté pour essayer de trouver une parade, mais pour l'instant rien.

Merci.

[ARTURO83]

Bonjour,

Dans les feuilles importées dans la feuille S0x_Planification, dans quelle colonne se trouvent les dates?

[elfyx]

Re,

Les dates se trouvent colonne C.

J'ai mis cette bidouille :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
    ShSOx.Columns("C:C").NumberFormat = "dd/mm/yyyy"
    
    'Relevé des infos
    For i = 2 To DerLig - 1
        Auteur(i) = ShSOx.Cells(i, "K")
        
        ShSOx.Cells(i, "C").Value = Format(ShSOx.Cells(i, "C").Value, "mm/dd/yyyy")
        
        vDate(i) = ShSOx.Cells(i, "C") * 1
        NumOp(i) = ShSOx.Cells(i, "E")
        Descript(i) = ShSOx.Cells(i, "M")
    Next i

ça marche mais ça doit pas être top.
Un autre point, lorsque l'auteur est introuvable, on sort de la macro (sub), est ce qu'il serait pas juste possible de passer à la ligne suivante à la place ?

[ARTURO83]

Un autre point, lorsque l'auteur est introuvable, on sort de la macro (sub), est ce qu'il serait pas juste possible de passer à la ligne suivante à la place ?

Oui remplacez le code comppris entre For 1 .... et Next i par

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
    For i = 2 To DerLig - 1
        'on recherche l'auteur
        Set Col_R = ShPlan.Rows(3).Find(Auteur(i), LookIn:=xlValues)
        If Not Col_R Is Nothing Then
            'On recherche la date
            Set Lig_D = ShPlan.Columns(2).Find(vDate(i), LookIn:=xlValues)
            If Lig_D Is Nothing Then
                MsgBox "Date introuvable"
                Exit Sub
            End If
 
            'Ajout de l'opérateur
            ShPlan.Cells(Lig_D.Row, Col_R.Column) = Cells(Lig_D.Row, Col_R.Column) & Chr(10) & NumOp(i)
 
            'Ajout du commentaire
            If ShPlan.Cells(Lig_D.Row, Col_R.Column).Comment Is Nothing Then
                With ShPlan.Cells(Lig_D.Row, Col_R.Column)
                    .AddComment
                    .Comment.Text Text:=Descript(i)
                End With
            Else
                CommentExist = ShPlan.Cells(Lig_D.Row, Col_R.Column).NoteText
                ShPlan.Cells(Lig_D.Row, Col_R.Column).Comment.Text Text:=CommentExist & Chr(10) & Descript(i)
            End If
            ShPlan.Cells(Lig_D.Row, Col_R.Column).Comment.Visible = False
        End If
    Next i

[elfyx]

Ok ça marche bien comme cela.

Un dernier point avant de clore la discussion
Si je souhaitais mettre à jour uniquement une semaine en particulier au lieu de toutes les semaines, que faudrait-il faire pour qu'au clic sur le bouton il demande un input du type (MAJ all ou MAJ à partir de la semaine X) ?

[ARTURO83]

Bonjour,

Avec la modif demandée:

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
117
118
119
120
121
122
123
Sub Transfert()
    Dim Semaine As String
    Dim i As Long
    Dim Col_R As Variant
    Dim Lig_D As Variant
 
    Application.ScreenUpdating = False
    Set ShSOx = Sheets("SOx_Planification")
    Set ShPlan = Sheets("Planning")
 
    DerLig = ShSOx.[K10000].End(xlUp).Row
    ReDim Auteur(DerLig - 1) As String
    ReDim vDate(DerLig - 1) As Long
    ReDim NumOp(DerLig - 1) As String
    ReDim Descript(DerLig - 1) As String
 
    Message = "Saisissez le numéro de la semaine à importer dans le planning" & Chr(10) & Chr(10) & "Par défaut: ""All"""
    Title = "Mise à jour du planning"
    Defaut = "All"
    Semaine = InputBox(Message, Title, Defaut)
    If Semaine = "" Then Exit Sub
 
    If Semaine = "All" Then
        'Relevé des infos
        For i = 2 To DerLig - 1
            Auteur(i) = ShSOx.Cells(i, "K")
            vDate(i) = ShSOx.Cells(i, "C") * 1
            NumOp(i) = ShSOx.Cells(i, "E")
            Descript(i) = ShSOx.Cells(i, "M")
        Next i
 
        '*****************Restitution des infos dans le planning****************************************************************
        'Conversion de la date en numérique
        ShPlan.Columns("B:B").NumberFormat = "0"
 
        For i = 2 To DerLig - 1
            'on recherche l'auteur
            Set Col_R = ShPlan.Rows(3).Find(Auteur(i), LookIn:=xlValues)
            If Not Col_R Is Nothing Then
                'On recherche la date
                Set Lig_D = ShPlan.Columns(2).Find(vDate(i), LookIn:=xlValues)
                If Lig_D Is Nothing Then
                    MsgBox "Date introuvable"
                    Exit Sub
                End If
 
                'Ajout de l'opérateur
                ShPlan.Cells(Lig_D.Row, Col_R.Column) = ShPlan.Cells(Lig_D.Row, Col_R.Column) & Chr(10) & NumOp(i)
                If Left(ShPlan.Cells(Lig_D.Row, Col_R.Column), 1) = Chr(10) Then ShPlan.Cells(Lig_D.Row, Col_R.Column) = Mid(ShPlan.Cells(Lig_D.Row, Col_R.Column), 2, Len(ShPlan.Cells(Lig_D.Row, Col_R.Column)) - 1)
 
                'Ajout du commentaire
                If ShPlan.Cells(Lig_D.Row, Col_R.Column).Comment Is Nothing Then
                    With ShPlan.Cells(Lig_D.Row, Col_R.Column)
                        .AddComment
                        .Comment.Text Text:=Descript(i)
                    End With
                Else
                    CommentExist = ShPlan.Cells(Lig_D.Row, Col_R.Column).NoteText
                    ShPlan.Cells(Lig_D.Row, Col_R.Column).Comment.Text Text:=CommentExist & Chr(10) & Descript(i)
                End If
                ShPlan.Cells(Lig_D.Row, Col_R.Column).Comment.Visible = False
            End If
        Next i
    Else
        Set D = ShSOx.Columns(1).Find(Semaine, LookIn:=xlValues, lookat:=xlWhole)
        If Not D Is Nothing Then
            'Relevé des infos
            i = 1
            Do While ShSOx.Cells(D.Row + i - 1, "A") = CByte(Semaine)
                Auteur(i) = ShSOx.Cells(D.Row + i - 1, "K")
                vDate(i) = ShSOx.Cells(D.Row + i - 1, "C") * 1
                NumOp(i) = ShSOx.Cells(D.Row + i - 1, "E")
                Descript(i) = ShSOx.Cells(D.Row + i - 1, "M")
                IMax = i
                i = i + 1
            Loop
 
        '*****************Restitution des infos dans le planning****************************************************************
            'Conversion de la date en numérique
            ShPlan.Columns("B:B").NumberFormat = "0"
 
            For i = 1 To IMax
                'on recherche l'auteur
                Set Col_R = ShPlan.Rows(3).Find(Auteur(i), LookIn:=xlValues)
                If Not Col_R Is Nothing Then
                    'On recherche la date
                    Set Lig_D = ShPlan.Columns(2).Find(vDate(i), LookIn:=xlValues)
                    If Lig_D Is Nothing Then
                        MsgBox "Date introuvable"
                        Exit Sub
                    End If
 
                    'Ajout de l'opérateur
                    ShPlan.Cells(Lig_D.Row, Col_R.Column) = ShPlan.Cells(Lig_D.Row, Col_R.Column) & Chr(10) & NumOp(i)
                    If Left(ShPlan.Cells(Lig_D.Row, Col_R.Column), 1) = Chr(10) Then ShPlan.Cells(Lig_D.Row, Col_R.Column) = Mid(ShPlan.Cells(Lig_D.Row, Col_R.Column), 2, Len(ShPlan.Cells(Lig_D.Row, Col_R.Column)) - 1)
                    'Ajout du commentaire
                    If ShPlan.Cells(Lig_D.Row, Col_R.Column).Comment Is Nothing Then
                        With ShPlan.Cells(Lig_D.Row, Col_R.Column)
                            .AddComment
                            .Comment.Text Text:=Descript(i)
                        End With
                    Else
                        CommentExist = ShPlan.Cells(Lig_D.Row, Col_R.Column).NoteText
                        ShPlan.Cells(Lig_D.Row, Col_R.Column).Comment.Text Text:=CommentExist & Chr(10) & Descript(i)
                    End If
                    ShPlan.Cells(Lig_D.Row, Col_R.Column).Comment.Visible = False
                End If
            Next i
        End If
    End If
 
    ShPlan.Columns("E:N").VerticalAlignment = xlTop
    ShPlan.Rows("4:1000").EntireRow.AutoFit
    'Remise au format date de la colonne B
    ShPlan.Columns("B:B").NumberFormat = "ddd dd/mmm/yyyy"
 
    ShPlan.Select
    Set Col_R = Nothing
    Set Lig_D = Nothing
    Set D = Nothing
    Set ShSOx = Nothing
    Set ShPlan = Nothing
End Sub

avec le fichier
Pièce jointe 443375

Cdlt