Discussion :

[VictorienR]

Bonjour à tous,

Alors voilà, j'ai un problème sur une manipulation que je souhaiterai faire sur un fichier excel :

J'ai un fichier avec une feuille "Plan de livraison" où sont répertoriés des lignes de pièces avec leurs noms, références, quantités à livrer, dates de livraison. Une feuille "Pièce de négoces" où sont répertoriés juste des noms et références de pièces qu'on peut dire "spécifiques". Une feuille "Planning" avec simplement un planning généré automatiquement avec une macro en fonction du plan de livraison. Et enfin une feuille "Planning Négoce" sur laquelle je voudrais faire la manipulation suivante :

Une inputbox demande a l'utilisateur de rentrer un "délai" (en semaines) de création du planning de négoce, et j'aimerai que lorsqu'une pièce du plan de livraison est contenue dans la liste des pièces de négoce, et que sa date de livraison est inférieur à la date du jour + le délai entré par l'utilisateur, alors on copie vers le planning de négoce toute la ligne du plan de livraison associée à cette pièce.
Parallèlement à cela, il faudrait que la ligne du Planning qui correspond à la pièce qu'on vient de copier vers le planning de négoce soit supprimée (puisqu'on en a du coup plus besoin sur le planning).

Je précise enfin que le traitement des pièces se fait en fonction de leurs références, puisque plusieurs pièces peuvent avoir le même nom mais pas les mêmes références.

Je vous joins à tout cela un fichier "test", ne pouvant pas donner mon fichier officiel, et pour que ce soit plus clair pour vous. Il y a dans le module1 le programme que j'ai tenté de faire mais qui n'est pas terminé (ne sachant pas comment définir certains paramètres.)

Je vous remercie par avance de votre aide, et vous souhaite une excellente après-midi !

Cordialement,

Victorien

*Edit : Je précise que les quantités et dates contenues entre le plan de livraison et le planning ne sont pas cohérentes, mais ce n'est pas grave le planning est juste là pour exemple, il faut utiliser tout de même les qtés/dates du plan de livraison

[gnain]

Bonjour,

premièrement supprimer votre sub Suppressioncontenu() car j'ai inclus la suppression dans le même sub

puis copier ce sub
les commentaires explique ce que ce code fait

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
Sub ExtractionNégoce()
 
Sheets("Plan de livraison").Activate
 
'Une inputbox demande a l'utilisateur de rentrer un "délai" (en semaines) de création du planning de négoce
délai = InputBox("Veuillez entrer le délai choisi en semaines (exemple : entrez 4 pour un délai choisi de 1 mois)", "Choix de délai", "4") 'La variable reçoit la valeur entrée dans l'InputBox
 
'récupère  la date du jour + le délai entré par l'utilisateur
Date_plus_Delai = Format(Now + (délai * 7), "yyyy-mm-dd")
 
 
For i = 2 To Sheets("Pièces de Négoce").Range("A" & Rows.Count).End(xlUp).Row
 
    For j = 2 To Sheets("Plan de livraison").Range("A" & Rows.Count).End(xlUp).Row
        'si la pièce du plan de livraison est contenue dans la liste des pièces de négoce,
        'et que sa date de livraison est inférieur à la date du jour + le délai entré par l'utilisateur
        If Sheets("Pièces de Négoce").Cells(i, 1).Value = Cells(j, 1).Value And _
        Sheets("Pièces de Négoce").Cells(i, 2).Value = Cells(j, 2).Value And _
        Cells(j, 5).Value < Date_plus_Delai Then
 
            'copie vers le planning de négoce toute la ligne du plan de livraison associée à cette pièce
            Rows(j & ":" & j).Copy Destination:=Sheets("Planning Négoce").Rows(Sheets("Planning Négoce").Range("A" & Rows.Count).End(xlUp).Row + 1 & ":" & Sheets("Planning Négoce").Range("A" & Rows.Count).End(xlUp).Row + 1)
            'on met un marqueur pour les lignes à supprimer, on les supprimera un peut plus loin grace à ce marqueur
            Cells(j, 20).Value = "*"
 
        End If
 
    Next
 
Next
 
For j = 2 To Sheets("Plan de livraison").Range("A" & Rows.Count).End(xlUp).Row
    If Cells(j, 20).Value = "*" Then
        'on batie le string des lignes à supprimer grace au marqueur
        supprime = supprime & j & ":" & j & ","
    End If
Next
    'on enlève la dernière virgule
    supprime = Left(supprime, Len(supprime) - 1)
    'on supprime les lignes
    Range(supprime).Delete Shift:=xlUp
 
Sheets("Planning Négoce").Activate
MsgBox "fin"
End Sub

note: une semaine = 7 jours donc 4 semaines = 28 jours et non 1 mois
dans l'exemple ci-haut si on choisie 4 semaines alors on additionne 28 jours à la date du jours

[VictorienR]

Bonjour gnain,

Je te remercie d'abord infiniment pour ton aide très précieuse ! Le code marche à merveille, le seul soucis est que je ne veux pas supprimer la ligne du plan de livraison, mais la ligne du planning qui est similaire à celle du plan de livraison que je viens de copier.

Par exemple : dans le plan de livraison, il y a la ligne avec le balancier de référence 750. Comme il est contenu dans la liste de pièces de négoce, je veux le copier sur le planning négoce. Je copie donc cette ligne, et une fois que je l'ai copiée, je vais regarder dans le Planning simple où elle est située et je vais la supprimer.

Merci beaucoup à toi,

Bonne journée

Victorien

[gnain]

Bonjour,

voici la correction
on efface ausitot qu'on a copier. voir commentaire

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
Sub ExtractionNégoce()
Sheets("Plan de livraison").Activate
 
'Une inputbox demande a l'utilisateur de rentrer un "délai" (en semaines) de création du planning de négoce
délai = InputBox("Veuillez entrer le délai choisi en semaines (exemple : entrez 4 pour un délai choisi de 1 mois)", "Choix de délai", "4") 'La variable reçoit la valeur entrée dans l'InputBox
 
'récupère  la date du jour + le délai entré par l'utilisateur
Date_plus_Delai = Format(Now + (délai * 7), "yyyy-mm-dd")
 
 
For i = 2 To Sheets("Pièces de Négoce").Range("A" & Rows.Count).End(xlUp).Row
 
    For j = 2 To Sheets("Plan de livraison").Range("A" & Rows.Count).End(xlUp).Row
        'si la pièce du plan de livraison est contenue dans la liste des pièces de négoce,
        'et que sa date de livraison est inférieur à la date du jour + le délai entré par l'utilisateur
        If Sheets("Pièces de Négoce").Cells(i, 1).Value = Cells(j, 1).Value And _
        Sheets("Pièces de Négoce").Cells(i, 2).Value = Cells(j, 2).Value And _
        Cells(j, 5).Value < Date_plus_Delai Then
 
            'copie vers le planning de négoce toute la ligne du plan de livraison associée à cette pièce
            Rows(j & ":" & j).Copy Destination:=Sheets("Planning Négoce").Rows(Sheets("Planning Négoce").Range("A" & Rows.Count).End(xlUp).Row + 1 & ":" & Sheets("Planning Négoce").Range("A" & Rows.Count).End(xlUp).Row + 1)
 
            For k = 6 To Sheets("Planning").Range("A" & Rows.Count).End(xlUp).Row
                'on vérifie si ligne pareil de planning et Pièces de Négoce
                If Sheets("Planning").Cells(k, 1).Value = Sheets("Pièces de Négoce").Cells(i, 1).Value And Sheets("Planning").Cells(k, 2).Value = Sheets("Pièces de Négoce").Cells(i, 2).Value Then
                    'si pareil on supprime
                    Sheets("Planning").Range(k & ":" & k).Delete Shift:=xlUp
                End If
            Next
 
        End If
 
    Next
 
Next
 
 
Sheets("Planning Négoce").Activate
MsgBox "fin"
 
End Sub

en espérant de vous avoir aidé.

[VictorienR]

Super, merci beaucoup ! Cependant, dernier petit soucis : il n'a pas l'air de supprimer les données précédentes à chaque fois qu'on relance la macro. Quand on clique plusieurs fois sur le bouton, les données se rajoutent à la suite de ce qui est déjà dans le planning Négoce.. J'ai essayé de rajouter à nouveau mon suppression contenu mais ce n'est pas efficace !

[gnain]

il n'a pas l'air de supprimer les données précédentes à chaque fois qu'on relance la macro. Quand on clique plusieurs fois sur le bouton, les données se rajoutent à la suite

Si j'ai bien compris tu veux effacer le contenue de la feuille Planning Négoce à chaque fois que tu lance la macro.
Si c'est bien cela alors placer ce code au tout début de la macro

Code :

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

Sheets("Planning Négoce").Rows("2:" & Sheets("Planning Négoce").Range("A" & Rows.Count).End(xlUp).Row).ClearContents

ceci effacera le contenue de la feuille Planning Négoce à chaque fois que tu lance la macro

[VictorienR]

Je te remercie infiniment, c'est tout à fait ce qu'il me fallait !

Bonne journée à toi

[VictorienR]

Bonjour,

Désolé de ressortir le post mais en fait je viens de m’apercevoir d'un soucis dans le programme, en le réutilisant...
En effet le critère de date n'est pas respecté, j'ai testé en mettant une date largement supérieure au délai et pourtant il copie quand même la ligne. De même pour les dates inférieures à la date du jour, j'aimerai que les pièces dont la date de livraison est déjà passée ne soient pas copiées dans le planning de négoce. Cependant j'ia tenté de modifier et je ne trouve pas le soucis...

Si vous pourriez bien m'aider ?
Je vous remet une copie du programme en pièce jointe

En vous remerciant,

Victorien

[gnain]

Bonjour,
il suffisait de déclarer la variable Date_plus_Delai

Code :

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

Dim Date_plus_Delai As Date

[VictorienR]

Bonjour gnain,

Je reviens vers toi car j'aurai besoin d'une petite amélioration sur ma macro :

J'ai ajouté une liste de délai à ma liste de pièces négoce (voir photo jointe), et j'aimerai que le délai associé à chaque pièce de négoce s'affiche dans la colonne laissée vide dans le planning de négoce. j'ai tenté une sorte de fonction "recherchev" codée en vba mais ca n'a pas l'air de fonctionner...
J'aimerai ensuite que le tableau soit également trié en fonction de la date de livraison (si possible en retirant le délai, par exemple la pièce 1 à livrer pour le 20/01 qui a un temps de livraison de 14 jours, (20-14 -> 06/01/2015) s'affiche avant la pièce à livrer pour le 16/01 qui a un délai de 7 jours (16-7 -> 09/01/2015) ).

en te remerciant d'avance et te souhaitant une bonne journée !

Victorien

[gnain]

Bonjour,
voici le code complet
voir commentaire

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
Sub ExtractionNégoce()
 
Dim Date_plus_Delai As Date
 
Sheets("Planning Négoce").Rows("2:" & Sheets("Planning Négoce").Range("A" & Rows.Count).End(xlUp).Row).ClearContents
Sheets("Plan de livraison").Activate
 
For i = 2 To Sheets("Pièces de Négoce").Range("A" & Rows.Count).End(xlUp).Row
 
    For j = 2 To Sheets("Plan de livraison").Range("A" & Rows.Count).End(xlUp).Row
 
        délai = Sheets("Pièces de Négoce").Cells(j, 3).Value
        Date_plus_Delai = Format(Now + (délai) + 56, "yyyy-mm-dd")
 
        'si la pièce du plan de livraison est contenue dans la liste des pièces de négoce,
        'et que sa date de livraison est inférieur à la date du jour + le délai entré par l'utilisateur
        If Sheets("Pièces de Négoce").Cells(i, 1).Value = Cells(j, 1).Value And _
        Sheets("Pièces de Négoce").Cells(i, 2).Value = Cells(j, 2).Value And _
        Cells(j, 5).Value < Date_plus_Delai Then
 
            'copie vers le planning de négoce toute la ligne du plan de livraison associée à cette pièce
            Rows(j & ":" & j).Copy Destination:=Sheets("Planning Négoce").Rows(Sheets("Planning Négoce").Range("A" & Rows.Count).End(xlUp).Row + 1 & ":" & Sheets("Planning Négoce").Range("A" & Rows.Count).End(xlUp).Row + 1)
 
            '========================================================
            'Nouvelle ligne ajoute delai
            Sheets("Planning Négoce").Cells(Sheets("Planning Négoce").Range("A" & Rows.Count).End(xlUp).Row, 8).Value = Sheets("Pièces de Négoce").Cells(i, 3).Value
            'Nouvelle ligne ajoute nouvelle colonne date + delai (servira à trier plus loin)
            Sheets("Planning Négoce").Cells(Sheets("Planning Négoce").Range("A" & Rows.Count).End(xlUp).Row, 9).Value = Sheets("Planning Négoce").Cells(Sheets("Planning Négoce").Range("A" & Rows.Count).End(xlUp).Row, 5).Value + Sheets("Planning Négoce").Cells(Sheets("Planning Négoce").Range("A" & Rows.Count).End(xlUp).Row, 8).Value
            '========================================================
 
            For k = 6 To Sheets("PlanningFinal").Range("A" & Rows.Count).End(xlUp).Row
                'on vérifie si ligne pareil de planning et Pièces de Négoce
                If Sheets("PlanningFinal").Cells(k, 1).Value = Sheets("Pièces de Négoce").Cells(i, 1).Value And Sheets("PlanningFinal").Cells(k, 2).Value = Sheets("Pièces de Négoce").Cells(i, 2).Value Then
                    'si pareil on supprime
                    Sheets("PlanningFinal").Range(k & ":" & k).Delete Shift:=xlUp
                End If
            Next
 
        End If
 
    Next
 
Next
 
Worksheets("Plan de livraison").Range("A1:J1").Copy Destination:=Worksheets("Planning Négoce").Range("A1:J1")
 
 
 
 
derligne = Worksheets("Planning Négoce").Cells(Rows.Count, 4).End(xlUp).Row
 
    For i = derligne To 2 Step -1
 
        If Worksheets("Planning Négoce").Cells(i, 4) = 0 Then
 
            Worksheets("Planning Négoce").Rows(i).Delete
 
        End If
 
    Next i
 
Sheets("Planning Négoce").Activate
 
    '=============================================================
    'Nouveau code
    'trie selon date
    Rows("2:" & Range("A" & Rows.Count).End(xlUp).Row).Select
    ActiveWorkbook.Worksheets("Planning Négoce").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Planning Négoce").Sort.SortFields.Add Key:=Range( _
        "I2:I" & Range("A" & Rows.Count).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Planning Négoce").Sort
        .SetRange Range("A2:J" & Range("A" & Rows.Count).End(xlUp).Row)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    '================================================================
MsgBox "Fin"
 
 
End Sub

[VictorienR]

Merci beaucoup pour tout cela, ça marche du tonnerre !

Dernière petite mise à jour, au niveau du code

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
For k = 6 To Sheets("PlanningFinal").Range("A" & Rows.Count).End(xlUp).Row
                'on vérifie si ligne pareil de planning et Pièces de Négoce
                If Sheets("PlanningFinal").Cells(k, 1).Value = Sheets("Pièces de Négoce").Cells(i, 1).Value And Sheets("PlanningFinal").Cells(k, 2).Value = Sheets("Pièces de Négoce").Cells(i, 2).Value Then
 
                       'si pareil on supprime le nombre mais pas la ligne complète
 
                   Sheets("PlanningFinal").Range(k & ":" & k).Interior.Color = RGB(80, 80, 80)
 
               End If
 
Next

Finalement il faudrait que la ligne dans planning final ne soit pas supprimée entièrement (qu'elle prenne juste la couleur comme je l'ai misci dessus), mais que ce soit seulement à partir de la colonne 4 que ce soit supprimé (pour garder le nom et la référence), autrement dit : j'aimerai supprimer Range ("D k : XY k"). Est-ce que tu pourrais juste m'expliquer comment adapter la formule

Code :

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

Sheets("PlanningFinal").Range(k & ":" & k).Delete Shift:=xlUp

?

En te remerciant, et te souhaitant une bonne après-midi !

Victorien

[gnain]

Bonjour,

Code :

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

Sheets("PlanningFinal").Range("D" & k & ":XY" & k).ClearContents

[VictorienR]

Merci pour tout gnain, vraiment très heureux de ton aide apportée !