Création de lignes via VBA sur un onglet en fonction de données sur un autre onglet

Version imprimable

23/05/2016, 21h03
zoeanyah

Création de lignes via VBA sur un onglet en fonction de données sur un autre onglet

Bonjour,

Je cherche à créer via macro, des lignes dasn un onglet en fonction de données d'un autre onglet.

avec un exemple :

1er onglet :

produit péremption (mois)

a 36

b 24

c 60

d 12

e 72

Je voudrais que lorsque j'indique via une textbox ma plage a à b, des lignes soient créées dans un second onglet avec une ligne par multiple de 12.

Dans mon exemple si je dis que je veux créer les lignes pour les produits b à c, j'ai dans le second onglet :

produit échéance

b 0

b 12

b 24

c 0

c 12

c 24

c 36

c 48

c 60

Est-ce que vous auriez une idée de comment faire cela ?

merci d'avance.
Zoé
23/05/2016, 21h40
joe.levrai
Bonjour,

ce n'est pas bien compliqué, pour chaque élément il suffit de faire une boucle For/Next comme ça (exemple avec un produit à péremption X mois) :
Code:

1 2 3 For i = X to 0 Step -12 'Ecriture de i en colonne B et du produit en Colonne A Next i
ce qui est le plus important, c'est la partie qui permet de choisir les éléments, c'est pas très clair dans ton explication.

comment tu vois la chose ? Comment marier tes deux éléments dans un textbox ? Comment l'utilisateur va savoir les deux produits "bornes" à choisir ? il dispose de quoi pour l'aider ? etc....

et d'un aspect purement pratique : comment doit réagir la procédure quand la péremption n'est pas un multiple de 12 ?
23/05/2016, 22h28
zoeanyah

1 pièce(s) jointe(s)

bonjour
merci d'avoir pris en compte ma demande.

je crois que le plus simple c'est de joindre mon fichier excel avec la macro que j'ai déjà attaqué
Pièce jointe 210588

Zoé
24/05/2016, 23h36
joe.levrai

Bonjour,

je n'ai pas besoin du fichier pour lire la procédure que tu as déjà commencé, il te suffit de copier les lignes de code dans un message

et surtout, le plus important est de bien décrire le point que j'ai soulevé, c'est à dire la partie où l'utilisateur choisi deux produits qui représenteront les bornes de traitement de ta liste de départ

Bonjour,

Désolé pour le retarde de réponse mais j'étais en formation sans accès à mon programme.

Voici le code utilisé :

Code:

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
Sub CREATIONECHEANCE()
 
' initialisation des variables
 
Dim TextBox1 As String
Dim TextBox2 As String
Dim a As String
Dim b As String
Dim i As Integer
Dim Lig As Long
Dim peremp As String
Dim cell As Range
 
 
Lig = 1
 
Application.ScreenUpdating = False
 
' Demande la plage de référence des études pour lesquelles il faut créer les lignes d'échéances
 
    TextBox1 = InputBox("Veuillez indiquer la première référence pour laquelle il faut créer les échéances (#AAAAA):")
    TextBox2 = InputBox("Veuillez indiquer la dernière référence pour laquelle il faut créer les échéances (#AAAAA):")
 
' attribution de l'adresse des cellules correspondantes et définition de la plage
 
    a = Cells.Find(TextBox1, , xlValues).Address
    b = Cells.Find(TextBox2, , xlValues).Address
 
   Set plage = Feuil6.Range(a, b)
   Set per = plage.Offset(0, 8)
 
 
' définition 1ère ligne vide dans la feuille de suivi des échéances
 
    Do While Not IsEmpty(Feuil9.Range("A" & Lig))
        Lig = Lig + 1
    Loop
 
    cell1 = Feuil9.Range("A" & Lig)
 
' création lignes échéances en fonction de la péremption
 
    For Each cell In per
 
'       Set cellp = cell.Offset(0, 8) ' 8 = nombre de colonne à droite de la cellule pour atteindre cellule péremption
'       Set peremp = cellp.Value
        Select Case cell.Value
            Case Is = 12
                Feuil9.Activate
                cell1.Select
                cell1.Value = cell.Value
                cell1.Offset(0, 14).Select.Value = 12
 
            Case Is = 24
                Feuil9.Activate
                cell1.Select
                cell1.Value = cell.Value - 12
                cell1.Offset(0, 14).Select.Value = 12
                cell1.Offset(1, 0).Select.Value = cell.Value
                cell1.Offset(1, 14).Select.Value = 24
 
            Case Is = 36
                Feuil9.Activate
                cell1.Select
                cell1.Value = cell.Value - 24
                cell1.Offset(0, 14).Select.Value = 12
                cell1.Offset(1, 0).Select.Value = cell.Value - 12
                cell1.Offset(1, 14).Select.Value = 24
                cell1.Offset(2, 0).Select.Value = cell.Value
                cell1.Offset(2, 14).Select.Value = 36
 
            Case Is = 48
                Feuil9.Activate
                cell1.Select
                cell1.Value = cell.Value - 36
                cell1.Offset(0, 14).Select.Value = 12
                cell1.Offset(1, 0).Select.Value = cell.Value - 24
                cell1.Offset(1, 14).Select.Value = 24
                cell1.Offset(2, 0).Select.Value = cell.Value - 12
                cell1.Offset(2, 14).Select.Value = 36
                cell1.Offset(3, 0).Select.Value = cell.Value
                cell1.Offset(3, 14).Select.Value = 48
 
            Case Is = 60
                Feuil9.Activate
                cell1.Select
                cell1.Value = cell.Value - 48
                cell1.Offset(0, 14).Select.Value = 12
                cell1.Offset(1, 0).Select.Value = cell.Value - 36
                cell1.Offset(1, 14).Select.Value = 24
                cell1.Offset(2, 0).Select.Value = cell.Value - 24
                cell1.Offset(2, 14).Select.Value = 36
                cell1.Offset(3, 0).Select.Value = cell.Value - 12
                cell1.Offset(3, 14).Select.Value = 48
                cell1.Offset(4, 0).Select.Value = cell.Value
                cell1.Offset(4, 14).Select.Value = 60
 
            Case Is = 72
                Feuil9.Activate
                cell1.Select
                cell1.Value = cell.Value - 60
                cell1.Offset(0, 14).Select.Value = 12
                cell1.Offset(1, 0).Select.Value = cell.Value - 48
                cell1.Offset(1, 14).Select.Value = 24
                cell1.Offset(2, 0).Select.Value = cell.Value - 36
                cell1.Offset(2, 14).Select.Value = 36
                cell1.Offset(3, 0).Select.Value = cell.Value - 24
                cell1.Offset(3, 14).Select.Value = 48
                cell1.Offset(4, 0).Select.Value = cell.Value - 12
                cell1.Offset(4, 14).Select.Value = 60
                cell1.Offset(5, 0).Select.Value = cell.Value
                cell1.Offset(5, 14).Select.Value = 72
 
        End Select
 
    Next
 
End Sub

je suis m'excuse en avance de mes faibles connaissances en VBA

Zoé

27/05/2016, 21h09
Kiouane

Quand tu postes un code, sélectionne le et clique sur le bouton # pour une meilleure visibilité. Merci!
27/05/2016, 21h18
zoeanyah

Ah merci je cherchais comment faire !
Je fais ça dès que j'ai accès à un PC

Zoé

Bonjour,

j'ai cru comprendre qu'il fallait le nom du produit en colonne A et la périodicité 14 colonnes plus loin, dans Feuil9
j'ai cru comprendre que les références sources sont dans une certaine colonne de Feuil6, et la date de péremption 8 colonnes plus loin

en sous-traitant la création des lignes, regarde si c'est ton souhait

Code:

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
Sub CREATIONECHEANCE()
' initialisation des variables
Dim a As Range, b As Range, Cell As Range
Const PERIODE As Long = 12
    Application.ScreenUpdating = False
    With Feuil6
        Set a = .Cells.Find(InputBox("Veuillez indiquer la première référence pour laquelle il faut créer les échéances (#AAAAA):"), , xlValues)
        If a Is Nothing Then MsgBox "Référence non trouvée": Exit Sub
 
        Set b = .Cells.Find(InputBox("Veuillez indiquer la dernière référence pour laquelle il faut créer les échéances (#AAAAA):"), , xlValues)
        If b Is Nothing Then MsgBox "Référence non trouvée": Exit Sub
 
        ' création lignes échéances en fonction de la péremption
        For Each Cell In .Range(a, b).Cells
            Call Remplissage(Feuil9.Cells(Rows.Count, 1).End(xlUp)(2), Cell.Value, PERIODE, CLng(Cell.Offset(0, 8).Value) / PERIODE)
        Next Cell
    End With
    Application.ScreenUpdating = True
End Sub
 
Sub Remplissage(ByVal PositionDepart As Range, Produit As String, ValeurDepart As Long, NombreDeFois As Long)
    Dim i As Long
    For i = 1 To NombreDeFois
        With PositionDepart.Offset(i - 1, 0)
            .Value = Produit
            .Offset(0, 14).Value = ValeurDepart * i
        End With
    Next i
End Sub

13/06/2016, 09h06
zoeanyah

Bonjour,

Désolé pour le retour tardif.

Merci pour ce code c'est presque ça !!!

2 petites questions que je n'ai pas réussi à résoudre seule :
- je voudrais qu'il y ai également une ligne "0" qui se créé à chaque fois càd que pour une péremption de 36 mois je voudrais que les lignes 0, 12, 24 et 36 soient créées ... je ne trouve pas comment insérer ce point dans le code...:oops:

- je voudrais également que la péremption est augmentée, le code puisse détecter les lignes déjà créées et créer les lignes supplémentaires à la suite. ex : pour une péremption passant de 24 à 36, il faut détecter les lignes 0 12 et 24 et créé à la suite la ligne 36... mes compétences en code s'arrêtent bien avant cela malheureusement...:(

Merci en touts cas.

Zoé

Pour,

pour la péremption "0", il suffit de jouer sur la valeur de i dans la procédure de remplissage
Code:

1 2 3 4 5 6 7 8 9 Sub Remplissage(ByVal PositionDepart As Range, Produit As String, ValeurDepart As Long, NombreDeFois As Long) Dim i As Long For i = 0 To NombreDeFois With PositionDepart.Offset(i, 0) .Value = Produit .Offset(0, 14).Value = ValeurDepart * i End With Next i End Sub
i commence maintenant par 0 (au lieu de 1) et le offset de la position de départ commence à i au lieu de i - 1

Pour la prolongation de péremption, y'a deux solutions :
- de détecter si un produit existe ... de le supprimer le cas échéant pour le recréer correctement ?
- sans passer par une suppression, détecter si un produit existe, et vérifier si l'ensemble des périodicités ont été crées

je pense que c'est la première solution la plus simple .... mais pas forcément. Ca dépend de la façon dont ton fichier est utilisé
mais tout est possible

14/06/2016, 07h21
zoeanyah

ah ok !!!!!

pour la péremption, la deuxième solution est préférable car il faut pas supprimer les lignes : c'est de l'historique

produit	échéance
b	0
b	12
b	24
c	0
c	12
c	24
c	36
c	48
c	60