Boucles sur des lignes et colonnes VBA

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Je suis débutante sur VBA et je souhaiterais créer une macro un peu complexe pour mon niveau.
Je vais vous joindre un fichier test dans lequel il y a deux onglet "ZMD-VTL-PAV" et "hist_lr_mnt".

Dans mon premier onglet "ZMD-VTL-PAV" figure des sites avec un nombre LR à livrer. Ils sont actuellement tous livrés en semaine 13.
Dans mon second onglet, je suis la livraison de mes LR par semaine que l'on trouve en colonne et qui s'allonge au fil du temps.

Ma macro consisterait à créer dans l'onglet "ZMD-VTL-PAV" une ligne pour chaque semaine de livraison avec le bon nombre de LR livré par semaine et les déduire de la ligne initiale en semaine 13.

Merci d'avance pour votre aide.

Pièce jointe 419433

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 Maj_NbLr_Hebdo()
 
Dim FL1 As Worksheet, FL2 As Worksheet, Cell As Range, NoCol As Integer, NoLig As Long
Dim DerLig As Long, DerCol As Integer, Var As Variant
Dim Adress As Variant
' Création d'un onglet temporaire
Sheets.Add After:=ActiveSheet
        ActiveSheet.Paste
        Sheets("Feuil1").Name = "Temp"
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "Réf Site"
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "Nb LR/Sem"
        Range("C1").Select
        ActiveCell.FormulaR1C1 = "No Sem"
        ' Ligne des titres créée en doublon car le "Range(Selection, Selection.End(xlDown)).Select" m'envoi trop loin si je me mets en A1
        Range("A2").Select
        ActiveCell.FormulaR1C1 = "Réf Site"
        Range("B2").Select
        ActiveCell.FormulaR1C1 = "Nb LR/Sem"
        Range("C2").Select
        ActiveCell.FormulaR1C1 = "No Sem"
 
Set FL1 = Worksheets("hist_lr_mnt")
    DerLig = Split(FL1.UsedRange.Address, "$")(4)
    DerCol = Columns(Split(FL1.UsedRange.Address, "$")(3)).Column
    ' Boucles sur les colonnes    
    Sheets("hist_lr_mnt").Select
    For NoCol = 6 To DerCol
        ActiveSheet.ShowAllData
        ActiveSheet.Range("$A$1:$G$1000").AutoFilter Field:=NoCol, Criteria1:="<>0"
        Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Temp").Select
        Range("A1").Select
        Selection.End(xlDown).Select
        ActiveSheet.Paste
        Sheets("hist_lr_mnt").Select
        Range("NoCoL").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Temp").Select
        Range("B1").Select 'Row fonctionnait au début mais plus à la réouverture du fichier
        Selection.End(xlDown).Select
        ActiveSheet.Paste
        Selection.AutoFilter
        ActiveSheet.Range("$A$1:$c$500").AutoFilter Field:="NoCol", Criteria1:="="
        Rows("3:7").Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.ShowAllData
        Range(DerLig, 3).Select
        Range(Selection, Selection.End(xlUp)).Select
        ActiveCell.FormulaR1C1 = NoCol  ' Cette fonction ne fonctionne pas je souhaite reproduire sur chaque ligne le numéro de semaine correspondant à la boucle en cours de copie
    Next
 
Set FL2 = Worksheets("Temp")
 
    DerLig = Split(FL2.UsedRange.Address, "$")(4)
    DerCol = Columns(Split(FL2.UsedRange.Address, "$")(3)).Column
 
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    Var = FL2.Cells(NoLig, NoCol)
            Adress = FL2.Cells(NoLig, 1)
 
        Sheets("ZMD-VTL-PAV").Select
        Adress = FL2.Cells(NoLig, 1)
        Sheets("ZMD-VTL-PAV").Select
        ActiveSheet.Range("$A$1:$AF$10000").AutoFilter Field:=1, Criteria1:= _
            Adress
        Range("L1").End(xlDown).Select 'Row fonctionnait au début
        ActiveCell.FormulaR1C1 = _
        "=RECHERCHEV(A4521;hist_lr_mnt!A:E;5;FAUX)-SOMME.SI(Temp!A:A;'ZMD-VTL-PAV'!A4521;Temp!B:B)"
        Application.CutCopyMode = False
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ' Boucles sur les lignes
    Sheets("FL2").Select
    For NoLig = 2 To DerLig
 
        Sheets("ZMD-VTL-PAV").Select
        Adress = FL2.Cells(NoLig, 1)
        Sheets("ZMD-VTL-PAV").Select
        ActiveSheet.Range("$A$1:$AF$10000").AutoFilter Field:=1, Criteria1:= _
            Adress
        'Range("L1").End(xlDown).Row
        'ActiveCell.FormulaR1C1 = _
        '"=RECHERCHEV(A4521;hist_lr_mnt!A:E;5;FAUX)-SOMME.SI(Temp!A:A;'ZMD-VTL-PAV'!A4521;Temp!B:B)"
        Range("A1").End(xlDown).Select 'Row fonctionnait au début
        Application.CutCopyMode = False
        Selection.Copy
        Selection.Insert Shift:=xlDown
        Sheets("hist_lr_mnt").Select
        Range("NoCol").End(xlUp).Select 'Row fonctionnait au début
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("ZMD-VTL-PAV").Select
        Range("J1").End(xlDown).Select 'Row fonctionnait au début
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("L1").End(xlDown).Select 'Row fonctionnait au début
        ActiveCell.FormulaR1C1 = _
        "=SOMME.SI.ENS(Temp!B:B;Temp!A:A;'ZMD-VTL-PAV'!A4522;Temp!C:C;'ZMD-VTL-PAV'!J4522)"
        Application.CutCopyMode = False
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Next
 
    Sheets("FL2").Select
    ActiveWindow.SelectedSheets.Delete
 
gesterr:
End Sub

15/10/2018, 16h49
Igloobel
Bonjour,

j'ai pas compris même en regardant ton fichier il faut donner plus de détail comment ça marche

en attendant tu peux simplifier ton code comme ceci
Code:

1 2 Range("A1").Select ActiveCell.FormulaR1C1 = "Réf Site"
en

Code:

Range("A1").Value = "Réf Site"

Select est inutile puisque le but est de mettre du texte dedans autant le faire tout de suite. De plus les Selects ralentisse le code.
FormulaR1C1 ne sert pas parce que c'est pas une formule il vaut mieux mettre Value
15/10/2018, 17h10
ID_SB

Bonjour Igloobel,

Merci pour le retour, mais si je mets ce code je ne pourrais pas mettre mes adresses à la chaîne en fonction du numéro de semaine.

Je veux mettre dans l'onglet "Temp" les livraisons de chaque semaine à la suite en ligne afin de faire une deduction du nb LR total - somme.si dans l'onglet "ZMD..." sur la ligne initiale.

Je vais reprendre mon code en expliquant mes démarches pas a pas.

Cordialement

1 pièce(s) jointe(s)

Bonjour,

Je reprend mon code avec un peux plus d'explication.

Ne sachant pas comment récupérer uniquement les adresses pour lesquelles j'ai des livraisons dans mes colonnes hebdo, j'ai opté pour la création d'un onglet temporaire "Temp"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Maj_NbLr_Hebdo()
 
Dim FL1 As Worksheet, FL2 As Worksheet, Cell As Range, NoCol As Integer, NoLig As Long
Dim DerLig As Long, DerCol As Integer, Var As Variant
Dim Adress As Variant
Création d'un onglet temporaire
Sheets.Add After:=ActiveSheet
        ActiveSheet.Paste
        Sheets("Feuil1").Name = "Temp"
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "Réf Site"
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "Nb LR/Sem"
        Range("C1").Select
        ActiveCell.FormulaR1C1 = "No Sem"
        ' Ligne des titres créée en doublon car le "Range(Selection, Selection.End(xlDown)).Select" m'envoi trop loin si je me mets en A1
        Range("A2").Select
        ActiveCell.FormulaR1C1 = "Réf Site"
        Range("B2").Select
        ActiveCell.FormulaR1C1 = "Nb LR/Sem"
        Range("C2").Select
        ActiveCell.FormulaR1C1 = "No Sem"

Je vais parcourir chaque colonne de mon onglet de suivi hebdo "hist_lr_mnt", récupérer pour chaque colonne les adresses livrées et les coller à la suite en ligne. une adresse sera donc susceptible d’apparaître deux fois pour des semaines différentes avec un nombre de LR différents. A ce niveau j'ai également un soucis, je ne sais pas comment lui dire d'aller à la première ligne vide pour coller chaque boucles.

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
Set FL1 = Worksheets("hist_lr_mnt")
    DerLig = Split(FL1.UsedRange.Address, "$")(4)
    DerCol = Columns(Split(FL1.UsedRange.Address, "$")(3)).Column
    Boucles sur les colonnes    
    Sheets("hist_lr_mnt").Select
    For NoCol = 6 To DerCol
        ActiveSheet.ShowAllData
        ActiveSheet.Range("$A$1:$G$1000").AutoFilter Field:=NoCol, Criteria1:="<>0"
        Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Temp").Select
        Range("A1").Select
        Selection.End(xlDown).Select
        ActiveSheet.Paste
        Sheets("hist_lr_mnt").Select
        Range("NoCoL").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Temp").Select
        Range("B1").Select 'Row fonctionnait au début mais plus à la réouverture du fichier
        Selection.End(xlDown).Select
        ActiveSheet.Paste
        Selection.AutoFilter
        ActiveSheet.Range("$A$1:$c$500").AutoFilter Field:="NoCol", Criteria1:="="
        Rows("3:7").Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.ShowAllData
        Range(DerLig, 3).Select
        Range(Selection, Selection.End(xlUp)).Select
        ActiveCell.FormulaR1C1 = NoCol  ' Cette fonction ne fonctionne pas je souhaite reproduire sur chaque ligne le numéro de semaine correspondant à la boucle en cours de copie
    Next

Une fois mon historique créé, je vais créer la ligne de ma livraison S*** dans l'onglet "ZMD-VTL-PAV". je recherche les premières livraisons S13 et déduit la somme des livraisons hebdo recensé dans mon "Temp".

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
Set FL2 = Worksheets("Temp")
 
    DerLig = Split(FL2.UsedRange.Address, "$")(4)
    DerCol = Columns(Split(FL2.UsedRange.Address, "$")(3)).Column
 
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    Var = FL2.Cells(NoLig, 3)
            Adress = FL2.Cells(NoLig, 1)
 
       Sheets("FL2").Select
 
  For NoLig = 2 To DerLig
 
        Sheets("ZMD-VTL-PAV").Select
        Adress = FL2.Cells(NoLig, 1)
        Sheets("ZMD-VTL-PAV").Select
        ActiveSheet.Range("$A$1:$AF$10000").AutoFilter Field:=1, Criteria1:= _
            Adress
        'Range("L1").End(xlDown).Row
        'ActiveCell.FormulaR1C1 = _
        '"=RECHERCHEV(A4521;hist_lr_mnt!A:E;5;FAUX)-SOMME.SI(Temp!A:A;'ZMD-VTL-PAV'!A4521;Temp!B:B)"
        Range("A1").End(xlDown).Select
        Application.CutCopyMode = False
        Selection.Copy
        Selection.Insert Shift:=xlDown
        Range("J1").End(xlDown).Value = Var
        Range("L1").End(xlDown).Select 
        ActiveCell.FormulaR1C1 = _
        "=SOMME.SI.ENS(Temp!B:B;Temp!A:A;'ZMD-VTL-PAV'!A4522;Temp!C:C;'ZMD-VTL-PAV'!J4522)"
        Application.CutCopyMode = False
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Next
 
    Sheets("FL2").Select
    ActiveWindow.SelectedSheets.Delete
 
gesterr:
End Sub

Merci d'avance.
Pièce jointe 419594