Discussion :

[VictorienR]

Bonjour à tous,

Je viens vous voir car j'ai un projet de création de planning pour lequel j'ai un code à établir, et je reste bloqué quant à l'écriture du code. Je vous explique tout et joins un fichier exemple pour bien illustrer : j'ai un planning sur lequel j'ai en ligne des pièces à livrer, en colonne des dates, et à l'interjection des deux j'ai des quantités à livrer.
Ce planning est créé par une macro (pas présente dans le fichier puisque inutile ici), et les pièces sont dans un ordre défini par une autre feuille. Cet ordre ne convient pas et je souhaite donc recopier ce planning sur un planning nommé "planning final".
L'ordre est donné sur la feuille planning final cependant il y a des pièces comprises dans cette liste qui ne sont pas dans la liste du planning de base.

J'aimerai que ma macro fasse un copiage des quantités à livrer aux bonne dates et aux bonnes pièces du planning 1 vers le planning final, en ignorant les pièces qui sont présentes dans planning final et absentes dans le planning initial et en coloriant leurs lignes.
J'ai tenté un code qui est dans le fichier, mais ça ne fonctionne pas trop (je suis plutôt novice en vba)

J'attends vos éventuelles réponses avec impatience !

En vous remerciant d'avance,

Victorien.

[eric4459]

Bonjour Victorien
Voici un code qui va copier les valeurs de Planning1 dans Planning final, pour les couleurs je n'y ai pas encore réfléchi.
Pour ce code j'ai supposé que les colonnes dates de chaque onglet étaient identiques, est-ce que ce sera toujours le cas?
J'aurais également besoins de complément d'infos:
Si il y a déjà une valeur dans la cellule de la ligne Piston du 14 avril dans le planning final, et qu'il y en a une aussi mais différente dans la même cellule de Planning 1 : on écrase l'ancienne valeur de Planning final et on colorie la ligne?
Si une ligne existe en planning 1 et pas en planning final on la crée?

code :

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
Sub Extraction()
Dim PL1 As Worksheet
Dim PLF As Worksheet
Dim P1 As Range
Dim Pf As Range
Dim i As Integer
Dim j As Integer
Dim Dcl1 As Integer
Set PL1 = ThisWorkbook.Sheets("Planning1")
Set PLF = ThisWorkbook.Sheets("Planning final")
Set P1 = PL1.Range("A6")
Set Pf = PLF.Range("A6")
P1 = P1.Offset(0)
Pf = Pf.Offset(0)
 
 
With Sheets("Planning1")
    Dcl1 = .Cells(2, .Columns.Count).End(xlToLeft).Column   ' On compte le nombre de colonne de l'onglet Planning1
End With
 
Do While Pf.Offset(j, 0) <> ""
    If P1.Offset(i, 0) = Pf.Offset(j, 0) And P1.Offset(i, 1) = Pf.Offset(j, 1) Then
        For j = 3 To Dcl1
            If P1.Offset(i, j) <> "" Then
            Pf.Offset(i, j) = P1.Offset(i, j)
           End If
        Next j
        i = i + 1
        j = 0
    Else
    i = i
    j = j + 1
    End If
 
Loop
End Sub

Eric

[VictorienR]

Bonjour Eric,

Tout d'abord merci pour ton code, c'est très gentil de ta part ! Cependant, je l'ai testé et il ne copie que les valeurs de Planning 1 pour les coller dans la même disposition sur le planning final, or comme l'ordre des pièces est changé dans le planning final, tout est mélangé.
En fait pour faire simple, le planning final n'est qu'une copie du planning1 mais avec les pièces dans un ordre différent.

Je vous demande un code pour le faire puisqu'avant j'avais un code de simple copie selon ordre donné, mais cela n'est finalement pas la bonne solution : le planning 1 est généré par une macro à partir d'un plan de livraison (3000 lignes avec à chaque fois une référence pièce, une date de livraison, une quantité), sauf que dans le plan de livraison, des pièces apparaissent et disparaissent selon les périodes, ce qui fait donc varier la position des pièces sur le planning final, or cette position doit être fixe.
C'est pour cela que j'ai donc décidé de fixer la liste des pièces de la feuille Planning Final (qui est en réalité la liste complète des pièces connues, c'est pour cela qu'il y a des pièces supplémentaires par rapport au planning 1) : on ne doit donc pas la modifier pour qu'elle garde la même disposition.
Pour cela il est donc nécessaire que la macro prenne les pièces une par une, aille les chercher dans le planning 1 et fasse un copié collé du reste de la ligne sur le planning final. Et si elle ne trouve pas la pièce (qui est présente dans le planning final) dans le planning 1, elle doit donc ne pas y toucher (ne surtout pas supprimer la ligne du planning final où elle est située), et aller à la suivante.

Pour répondre à tes questions:

Si il y a déjà une valeur dans la cellule de la ligne Piston du 14 avril dans le planning final, et qu'il y en a une aussi mais différente dans la même cellule de Planning 1 : on écrase l'ancienne valeur de Planning final et on colorie la ligne?

-> je rajouterai sur la macro un nettoyage des quantités sur le planning final, ce qui veut dire qu'il n'y aura rien sur celui-ci. On rempli donc le planning final, et quand une ligne est vide on la laisse et on la colorie.

Pour ce code j'ai supposé que les colonnes dates de chaque onglet étaient identiques, est-ce que ce sera toujours le cas?

-> les dates entre les deux planning seront toujours identiques, puisque l'un est un copié-collé de l'autre.

Si une ligne existe en planning 1 et pas en planning final on la crée?

-> Très bonne question, tu viens de me faire penser au cas où une pièce encore inconnue jusqu'alors apparaîtrait sur le plan de livraison et donc sur le planning 1, dans ce cas oui il serait intéressant de la rajouter sur le planning final (éventuellement tout à la fin) !

En tout cas je te remercie pour tout le temps que tu m'accordes, vraiment très gentil de ta part

[eric4459]

Effectivement,
il y avait comme un problème, j'ai corrigé le code et l'ai testé.
Je reviens vers toi pour le reste.

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
 
Sub Extraction()
Dim PL1 As Worksheet
Dim PLF As Worksheet
Dim P1 As Range
Dim Pf As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Dcl1 As Integer
Set PL1 = ThisWorkbook.Sheets("Planning1")
Set PLF = ThisWorkbook.Sheets("Planning final")
Set P1 = PL1.Range("A6")
Set Pf = PLF.Range("A6")
P1 = P1.Offset(0)
Pf = Pf.Offset(0)
 
 
With Sheets("Planning1")
    Dcl1 = .Cells(2, .Columns.Count).End(xlToLeft).Column   ' On compte le nombre de colonne de l'onglet Planning1
End With
 
Do While Pf.Offset(j, 0) <> "" ' Cette boucle va fonctionner tant que la colonne A de l'onglet Planning Final n'est pas vide
    If P1.Offset(i, 0) = Pf.Offset(j, 0) And P1.Offset(i, 1) = Pf.Offset(j, 1) Then 'Ici on sélectionne les valeurs de Planning 1 qui sont égale à celle de Planning final
    k = j ' quand les valeurs sont égale on met en mémoire le numéro de ligne de l'onglet Planning Final
        For j = 3 To Dcl1 'Ici on va boucler sur toute les cellules de la ligne
            If P1.Offset(i, j) <> "" Then
            Pf.Offset(k, j) = P1.Offset(i, j)
            End If
        Next j
        i = i + 1 ' si on a trouvé des valeurs égales on passe à la ligne suivante de la feuille Planning1
        j = 0
    Else
    i = i ' Si on n'as pas de valeurs identiques on reste sur la même ligne de la feuille Planning1 et on passe à la ligne suivante de l'onglet Planning Final
    j = j + 1
    End If
 
 
Loop
End Sub

Eric

[eric4459]

Bonsoir Victorien,
Voici, avant de rentrer à la maison , le code avec ajout d'une nouvelle ligne sur le Planning final si elle n'y est pas encore (cas d'un nouvel équipement).
J'ai testé, ça fonctionne chez moi.
Restera les couleurs, demain....

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
Sub Extraction()
Dim PL1 As Worksheet
Dim PLF As Worksheet
Dim P1 As Range
Dim Pf As Range
Dim NvlleLigne As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Dcl1 As Integer
Dim Dlg1 As Integer
Dim Item As Range
Set PL1 = ThisWorkbook.Sheets("Planning1")
Set PLF = ThisWorkbook.Sheets("Planning final")
Set P1 = PL1.Range("A6")
Set Pf = PLF.Range("A6")
Set NvlleLigne = PLF.Range("A1")
P1 = P1.Offset(0)
Pf = Pf.Offset(0)
NvlleLigne = NvlleLigne.Offset(0)
 
 
With Sheets("Planning1")
    Dcl1 = .Cells(2, .Columns.Count).End(xlToLeft).Column   ' On compte le nombre de colonne de l'onglet Planning1
End With
 
With Sheets("Planning final")
    Dlg1 = .Cells(.Rows.Count, 1).End(xlUp).Row - 1 ' On compte le nombre de ligne de la feuille Planning final
End With
 
With Sheets("Planning1")
    Dlg2 = .Cells(.Rows.Count, 1).End(xlUp).Row - 1 ' On compte le nombre de ligne de la feuille Planning1
End With
 
 
PLF.Range("D6:J" & Dlg1 + 1).ClearContents ' Ici on effece les données de la feuille Planning final ( en supposant que le nombre de colonne sera toujours le même)
PLF.Range("D6:J" & Dlg1 + 1).Interior.ColorIndex = 15 ' On colorie en gris
 
For i = 0 To Dlg2 ' cette boucle va ajouter de nouvelles ligne sur la feuille planning final si elles n'existent pas
    Set Item = PLF.Columns(1).Find(P1.Offset(i, 0), LookIn:=xlValues, LookAt:=xlWhole)
    If Item Is Nothing Then
     PLF.Range("A" & Dlg1 & ":" & "J" & Dlg1).Copy
     NvlleLigne.Offset(Dlg1 + 1, 0).PasteSpecial
     NvlleLigne.Offset(Dlg1 + 1, 0) = P1.Offset(i, 0)
     NvlleLigne.Offset(Dlg1 + 1, 1) = P1.Offset(i, 1)
     Dlg1 = Dlg1 + 1
   End If
Next i
i = 0
 
Do While Pf.Offset(j, 0) <> "" ' Cette boucle va fonctionner tant que la colonne A de l'onglet Planning Final n'est pas vide
    If P1.Offset(i, 0) = Pf.Offset(j, 0) And P1.Offset(i, 1) = Pf.Offset(j, 1) Then 'Ici on selectionne les valeurs de Planning 1 qui sont égale à celle de Plannig final
    k = j ' quand les valeurs sont égale on met en mémoire le numéro de ligne de l'onglet Planning Final
        For j = 3 To Dcl1 + 1 'Ici on va boucler sur toute les cellules de la ligne
            If P1.Offset(i, j) <> "" Then
            Pf.Offset(k, j) = P1.Offset(i, j)
            End If
        Next j
        i = i + 1 ' si on a trouvé des valeurs égales on passe à la ligne suivante de la feuille Planning1
        j = 0
    Else
    i = i ' Si on n'as pas de valeurs identiques on reste sur la meme ligne de la feuille Planning1 et on passe à la ligne suivante de l'onglet Planning Final
    j = j + 1
    End If
 
Loop
 
End Sub

[VictorienR]

Bonjour Eric,

Vraiment très sympa de ta part de m'accorder autant d'aide, le programme marche super bien ! Simple petit ajout par soucis de perfectionnisme chez moi, que je voulais faire : je voulais colorer d'une autre couleur également la nouvelle ligne ajoutée si elle n'y était pas encore, j'ai tenté un :

Code :

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

Rows(Dlg1).Interior.ColorIndex = 3

ou encore un

Code :

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

Rows(NvlleLigne).Interior.ColorIndex = 3

Mais ça n'a pas l'air de bien fonctionner ! Quelle est la variable qui a pour valeur la ligne de la nouvelle pièce ajoutée ?

Je t'en remercie et te souhaite une bonne journée !

Restera les couleurs, demain....

Pour les couleurs, je viens d'y réfléchir, si une ligne est vide cela signifie que la somme vaut 0, donc j'ai rajouté le code suivant à la fin :

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
'Mise en couleur pièces somme nulle
 
Dim derligne As Integer
 
derligne = Worksheets("Planning final").Cells(Rows.Count, 3).End(xlUp).Row
 
For i = derligne To 6 Step -1
 
    If Worksheets("Planning final").Cells(i, 3) = 0 Then 'Si la somme vaut 0
 
        Worksheets("Planning final").Rows(i).Interior.Color = RGB(80, 80, 80) 'Alors son colorie la ligne en gris
 
    Else
 
         Worksheets("Planning final").Cells(i, 3).Interior.Color = RGB(260, 260, 260) 'Sinon on la met en blanc
 
    End If
 
Next i

Je crois qu'on en arrive à la fin !

[eric4459]

Bonjour Victorien,
Voici le code (final ? ), j'ai corrigé quelques erreurs dans la déclaration des variables et dans le code.
Quand un nouvel équipement est ajouté il est colorié en vert.
Les lignes où l'on colle les données sont aussi coloriées d'une autre couleur, mais on peut faire l'inverse.

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
Option Explicit
 
Sub Extraction()
Dim PL1 As Worksheet
Dim PLF As Worksheet
Dim P1 As Range
Dim Pf As Range
Dim NvlleLigne As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Dcl1 As Integer
Dim Dlg1 As Integer
Dim Dlg2 As Integer
Dim Item As Range
Set PL1 = ThisWorkbook.Sheets("Planning1")
Set PLF = ThisWorkbook.Sheets("Planning final")
Set P1 = PL1.Range("A6")
Set Pf = PLF.Range("A6")
Set NvlleLigne = PLF.Range("A1")
P1 = P1.Offset(0)
Pf = Pf.Offset(0)
NvlleLigne = NvlleLigne.Offset(0)
 
Application.ScreenUpdating = False 'Bloque le rafraichissement de l'écran
 
 
With Sheets("Planning1")
    Dcl1 = .Cells(2, .Columns.Count).End(xlToLeft).Column   ' On compte le nombre de colonne de l'onglet Planning1
End With
 
With Sheets("Planning final")
    Dlg1 = .Cells(.Rows.Count, 1).End(xlUp).Row  ' On compte le nombre de ligne de la feuille Planning final
End With
 
With Sheets("Planning1")
    Dlg2 = .Cells(.Rows.Count, 1).End(xlUp).Row  ' On compte le nombre de ligne de la feuille Planning1
End With
 
 
PLF.Range("D6:J" & Dlg1).ClearContents  ' Ici on effece les données de la feuille Planning final ( en supposant que le nombre de colonne sera toujours le même)
PLF.Range("D6:J" & Dlg1).Interior.ColorIndex = 15  ' On colorie en gris
 
For i = 0 To Dlg2 ' cette boucle va ajouter de nouvelles ligne sur la feuille planning final si elles n'existent pas
    Set Item = PLF.Columns(1).Find(P1.Offset(i, 0), LookIn:=xlValues, LookAt:=xlWhole)
    If Item Is Nothing Then
     PLF.Range("A" & Dlg1 & ":" & "J" & Dlg1).Copy
     NvlleLigne.Offset(Dlg1, 0).PasteSpecial
     NvlleLigne.Offset(Dlg1, 0) = P1.Offset(i, 0)
     NvlleLigne.Offset(Dlg1, 1) = P1.Offset(i, 1)
     PLF.Range("D" & Dlg1 + 1 & ":" & "J" & Dlg1 + 1).Interior.ColorIndex = 4 ' on colorie la nouvelle ligne
     Dlg1 = Dlg1 + 1
    Application.CutCopyMode = False ' arrête la surbrillance de la ligne copiée
   End If
Next i
i = 0
 
Do While Pf.Offset(j, 0) <> "" ' Cette boucle va fonctionner tant que la colonne A de l'onglet Planning Final n'est pas vide
    If P1.Offset(i, 0) = Pf.Offset(j, 0) And P1.Offset(i, 1) = Pf.Offset(j, 1) Then 'Ici on selectionne les valeurs de Planning 1 qui sont égale à celle de Plannig final
    k = j ' quand les valeurs sont égale on met en mémoire le numéro de ligne de l'onglet Planning Final
        For j = 3 To Dcl1 + 1 'Ici on va boucler sur toute les cellules de la ligne
            If P1.Offset(i, j) <> "" Then
            Pf.Offset(k, j) = P1.Offset(i, j)
            If PLF.Range("D" & k + 6 & ":" & "J" & k + 6).Interior.ColorIndex <> 4 Then 'Ici on impose k+6 car la référence de Pf est A6
            PLF.Range("D" & k + 6 & ":" & "J" & k + 6).Interior.ColorIndex = 28 ' on colorie les lignes où il y a des données sauf is il s'agit d'un nouvel équipement.
            End If
            End If
        Next j
        i = i + 1 ' si on a trouvé des valeurs égales on passe à la ligne suivante de la feuille Planning1
        j = 0
    Else
    i = i ' Si on n'as pas de valeurs identiques on reste sur la meme ligne de la feuille Planning1 et on passe à la ligne suivante de l'onglet Planning Final
    j = j + 1
    End If
 
Loop
Application.ScreenUpdating = True ' autorise le rafraichissement de l'écran
End Sub

Eric