Réduire un code VBA

Version imprimable

Réduire un code VBA

Bonjour à tous,

Dans les deux procédures suivantes, le code est presque le même excepter quelques détails prés.

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
Sub Stock_Bon()
    Dim sDerLig As Integer, DerLig As Integer, lDerlig As Integer
 
    '-- Définition des plages nommées dans la feuille "BD"
    With Sheets("BD")
        DerLig = .Range("A" & Rows.Count).End(xlUp).Row
        'MsgBox "bDerLig : " & bDerLig
        .Range("A1:K" & DerLig).Name = "ZoneExtract"
        .Range("A2:A" & DerLig).Name = "sRéférence"
        .Range("C2:C" & DerLig).Name = "sEtat"
        .Range("D2:D" & DerLig).Name = "sDate"
        .Range("E2:E" & DerLig).Name = "sMouvement"
        .Range("F2:F" & DerLig).Name = "sQuantité"
    End With
 
    With Sheets("Listes")
        lDerlig = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A2:E" & lDerlig).Name = "TabRef"
        .Range("A2:A" & lDerlig).Name = "Ref"
    End With
 
    '-- Filtre
    Sheets("B").Activate
 
    [ZoneExtract].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("B").Range("A3:B3"), Unique:=True
 
    '-- Définition des plages nommées dans la& feuille "B"
    With Sheets("B")
        sDerLig = .Range("A" & Rows.Count).End(xlUp).Row
 
        .Range("D4:D" & sDerLig).Name = "bEntréeS"
        .Range("E4:E" & sDerLig).Name = "bSortieS"
        .Range("F4:F" & sDerLig).Name = "bStockDispoS"
        .Range("C4:C" & sDerLig).Name = "bStockInitialS"
        .Range("G4:G" & sDerLig).Name = "bStockMiniS"
        .Range("H4:H" & sDerLig).Name = "bDateS"
        .Range("I4:I" & sDerLig).Name = "bAlerteS"
    End With
 
    '-- Ecriture des formules et calcul
    With Sheets("B")
 
        '-- Formule pour calculer la somme des entrées pour une référence
        .Range("D4").Formula = "=SUMPRODUCT((sRéférence=$A4)*(sEtat=""B"")*(sMouvement=""Entrée"")*(sQuantité))"
        .Range("D4").AutoFill Destination:=[bEntréeS], Type:=xlFillDefault
 
        '-- Formule pour calculer la somme des sorties pour une référence
        .Range("E4").Formula = "=SUMPRODUCT((sRéférence=$A4)*(sEtat=""B"")*(sMouvement=""Sortie"")*(sQuantité))"
        .Range("E4").AutoFill Destination:=[bSortieS], Type:=xlFillDefault
 
        '-- Formule pour calculer la quantité en stock pour une référence
        .Range("F4").Formula = "=C4+(D4-E4)"
        .Range("F4").AutoFill Destination:=[bStockDispoS], Type:=xlFillDefault
 
        '---- Affichage du stock initial correspondant ---
        Range("C4").Formula = "=INDEX(TabRef,MATCH($A4,Ref,0),4)"
        Range("C4").AutoFill Destination:=[bStockInitialS], Type:=xlFillDefault
 
        '---- Affichage du stock mini correspondant ---
        Range("G4").Formula = "=INDEX(TabRef,MATCH($A4,Ref,0),5)"
        Range("G4").AutoFill Destination:=[bStockMiniS], Type:=xlFillDefault
 
        '-----
 
        '-- Calcul de la date du dernier mouvement
        '.Range("H4").FormulaArray = "=MAX(IF((sRéférence=$A4)*(sEtat=""B""),sDate))"
        .Range("H4").FormulaArray = "=MAX((sRéférence=$A4)*(sEtat=""B"")*sDate)"
        .Range("H4").AutoFill Destination:=[bDateS], Type:=xlFillDefault
        [bDateS].NumberFormat = "m/d/yyyy h:mm"
 
        '-- Derniere colonne
        .Range("I4").Formula = "=IF(bStockMiniS="""","""",IF(bStockDispoS<bStockMiniS,""Attention: Stock bas"",""RAS""))"
        .Range("I4").AutoFill Destination:=[bAlerteS], Type:=xlFillDefault
        Application.Calculation = xlCalculationAutomatic
 
        Columns("A:I").EntireColumn.AutoFit
    End With
End Sub

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
Sub Stock_Mauvais()
    Dim sDerLig As Integer, DerLig As Integer, lDerlig As Integer
 
    '-- Définition des plages nommées dans la feuille "BD"
    With Sheets("BD")
        DerLig = .Range("A" & Rows.Count).End(xlUp).Row
        'MsgBox "bDerLig : " & bDerLig
        .Range("A1:K" & DerLig).Name = "ZoneExtract"
        .Range("A2:A" & DerLig).Name = "sRéférence"
        .Range("C2:C" & DerLig).Name = "sEtat"
        .Range("D2:D" & DerLig).Name = "sDate"
        .Range("E2:E" & DerLig).Name = "sMouvement"
        .Range("F2:F" & DerLig).Name = "sQuantité"
    End With
 
    With Sheets("Listes")
        lDerlig = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A2:E" & lDerlig).Name = "TabRef"
        .Range("A2:A" & lDerlig).Name = "Ref"
    End With
 
    '-- Filtre
    Sheets("M").Activate
 
    [ZoneExtract].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("M").Range("A3:B3"), Unique:=True
 
    '-- Définition des plages nommées dans la& feuille "M"
    With Sheets("M")
        sDerLig = .Range("A" & Rows.Count).End(xlUp).Row
 
        .Range("D4:D" & sDerLig).Name = "mEntréeS"
        .Range("E4:E" & sDerLig).Name = "mSortieS"
        .Range("F4:F" & sDerLig).Name = "mStockDispoS"
        .Range("C4:C" & sDerLig).Name = "mStockInitialS"
        .Range("G4:G" & sDerLig).Name = "mStockMiniS"
        .Range("H4:H" & sDerLig).Name = "mDateS"
        .Range("I4:I" & sDerLig).Name = "mAlerteS"
    End With
 
    '-- Ecriture des formules et calcul
    With Sheets("M")
 
        '-- Formule pour calculer la somme des entrées pour une référence
        .Range("D4").Formula = "=SUMPRODUCT((sRéférence=$A4)*(sEtat=""M"")*(sMouvement=""Entrée"")*(sQuantité))"
        .Range("D4").AutoFill Destination:=[mEntréeS], Type:=xlFillDefault
 
        '-- Formule pour calculer la somme des sorties pour une référence
        .Range("E4").Formula = "=SUMPRODUCT((sRéférence=$A4)*(sEtat=""M"")*(sMouvement=""Sortie"")*(sQuantité))"
        .Range("E4").AutoFill Destination:=[mSortieS], Type:=xlFillDefault
 
        '-- Formule pour calculer la quantité en stock pour une référence
        .Range("F4").Formula = "=C4+(D4-E4)"
        .Range("F4").AutoFill Destination:=[mStockDispoS], Type:=xlFillDefault
 
        '---- Affichage du stock initial correspondant ---
        Range("C4").Formula = "=INDEX(TabRef,MATCH($A4,Ref,0),4)"
        Range("C4").AutoFill Destination:=[mStockInitialS], Type:=xlFillDefault
 
        '---- Affichage du stock mini correspondant ---
        Range("G4").Formula = "=INDEX(TabRef,MATCH($A4,Ref,0),5)"
        Range("G4").AutoFill Destination:=[mStockMiniS], Type:=xlFillDefault
 
        '-----
        '-- Calcul de la date du dernier mouvement
        '.Range("H4").FormulaArray = "=MAX(IF((sRéférence=$A4)*(sEtat=""M""),sDate))"
        .Range("H4").FormulaArray = "=MAX((sRéférence=$A4)*(sEtat=""M"")*sDate)"
        .Range("H4").AutoFill Destination:=[mDateS], Type:=xlFillDefault
        [mDateS].NumberFormat = "m/d/yyyy h:mm"
 
        '-- Derniere colonne
        .Range("I4").Formula = "=IF(mStockMiniS="""","""",IF(mStockDispoS<mStockMiniS,""Attention: Stock bas"",""RAS""))"
        .Range("I4").AutoFill Destination:=[mAlerteS], Type:=xlFillDefault
 
        Application.Calculation = xlCalculationAutomatic
        Columns("A:I").EntireColumn.AutoFit
    End With
End Sub

Alors, j'aimerais bien réduire ce code, c'est si possible.

Merci d'avance.

17/10/2012, 10h50
issoram

Bonjour,

Il te suffit d'identifier toutes les variables communes à tes 2 procédures et à les passer en paramètres d'un procédure commune.

Bonne journée.

Salut,

Si j'ai bien vu la seule différence est M ou B donc tu peux faire une procédure global
Code:

1 2 3 4 5 Sub Stock (Type as String) 'A l'intérieur le même code en remplacent les B ou M par Type End Sub
Et tes deux procédures faisant appel à celle-ci:
Code:

1 2 3 4 Sub Stock_Bon() Call Stock(B) End Sub
Code:

1 2 3 4 Sub Stock_Mauvais() Call Stock(M) End Sub

Bonjour issoram, gbbtt,

Citation:

Envoyé par issoram

Il te suffit d'identifier toutes les variables communes à tes 2 procédures et à les passer en paramètres d'un procédure commune.

Ce qui est commun entre les deux procedures, est la définition des plages nommées dans la feuille "BD" et les formules.

Ce qui est déférent, c'est les plages nommées de chaque onglet avec leur noms ("B" et "M").

Merci de l'idée gbbtt.

Bonsoir,

Un essai :

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
Sub Stocks()
    Dim DerLig As Integer, lDerlig As Integer
    Dim N As String
    '-- Définition des plages nommées dans la feuille "BD"
    With Sheets("BD")
        DerLig = .Range("A" & Rows.Count).End(xlUp).Row
 
        .Range("A1:K" & DerLig).Name = "ZoneExtract"
        .Range("A2:A" & DerLig).Name = "sRéférence"
        .Range("C2:C" & DerLig).Name = "sEtat"
        .Range("D2:D" & DerLig).Name = "sDate"
        .Range("E2:E" & DerLig).Name = "sMouvement"
        .Range("F2:F" & DerLig).Name = "sQuantité"
    End With
 
    With Sheets("Listes")
        lDerlig = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A2:E" & lDerlig).Name = "TabRef"
        .Range("A2:A" & lDerlig).Name = "Ref"
    End With
    N = ActiveSheet.Name
    Call Stock(N)
 
    Application.Calculation = xlCalculationAutomatic
    Columns("A:I").EntireColumn.AutoFit
End Sub
 
Sub Stock(Nom As String)
    Dim sDerLig As Integer
 
    With Sheets(Nom)
 
        '-- Filtre
        .Activate
        [ZoneExtract].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A3:B3"), Unique:=True
 
        '-- Définition des plages nommées dans la& feuille "Nom"
        sDerLig = .Range("A" & Rows.Count).End(xlUp).Row
        x = LCase(Nom)
        .Range("D4:D" & sDerLig).Name = x & "EntréeS"
        .Range("E4:E" & sDerLig).Name = x & "SortieS"
        .Range("F4:F" & sDerLig).Name = x & "StockDispoS"
        .Range("C4:C" & sDerLig).Name = x & "StockInitialS"
        .Range("G4:G" & sDerLig).Name = x & "StockMiniS"
        .Range("H4:H" & sDerLig).Name = x & "DateS"
        .Range("I4:I" & sDerLig).Name = x & "AlerteS"
 
        '-- Ecriture des formules et calcul --'
 
        '-- Formule pour calculer la somme des entrées pour une référence
        .Range("D4").Formula = "=SUMPRODUCT((sRéférence=$A4)*(sEtat=""B"")*(sMouvement=""Entrée"")*(sQuantité))"
        .Range("D4").AutoFill Destination:=[x & EntréeS], Type:=xlFillDefault
 
        '-- Formule pour calculer la somme des sorties pour une référence
        .Range("E4").Formula = "=SUMPRODUCT((sRéférence=$A4)*(sEtat=""B"")*(sMouvement=""Sortie"")*(sQuantité))"
        .Range("E4").AutoFill Destination:=[x & SortieS], Type:=xlFillDefault
 
        '-- Formule pour calculer la quantité en stock pour une référence
        .Range("F4").Formula = "=C4+(D4-E4)"
        .Range("F4").AutoFill Destination:=[x & StockDispoS], Type:=xlFillDefault
 
        '---- Affichage du stock initial correspondant ---
        Range("C4").Formula = "=INDEX(TabRef,MATCH($A4,Ref,0),4)"
        Range("C4").AutoFill Destination:=[x & StockInitialS], Type:=xlFillDefault
 
        '---- Affichage du stock mini correspondant ---
        Range("G4").Formula = "=INDEX(TabRef,MATCH($A4,Ref,0),5)"
        Range("G4").AutoFill Destination:=[x & StockMiniS], Type:=xlFillDefault
 
        '-----
 
        '-- Calcul de la date du dernier mouvement
        .Range("H4").FormulaArray = "=MAX((sRéférence=$A4)*(sEtat=""Nom"")*sDate)"
        .Range("H4").AutoFill Destination:=[x & DateS], Type:=xlFillDefault
        [x & DateS].NumberFormat = "dd/mm/yyyy  hh:mm"
 
        '-- Derniere colonne
        .Range("I4").Formula = "=IF(x & StockMiniS="""","""",IF(x & StockDispoS < x & StockMiniS,""Attention: Stock bas"",""RAS""))"
        .Range("I4").AutoFill Destination:=[x & AlerteS], Type:=xlFillDefault
    End With
End Sub

Mais il y a une erreur pour utiliser les plages nommées de cette façon :

[x & EntréeS]

17/10/2012, 16h52
gbbtt

A priori ce que j'ai proposé fonctionne, certes tu te retrouves avec 3 procédures, mais seulement une contient vraiment du code!

Sinon pour mettre dans une seule procédure il faut à un moment que tu détermine le nom de la feuille (B ou M) (par un userform par exemple)

Edit: Au temps pour moi, j'avais mal analysé la proposition que tu as fait dans le message précédent, je relis le code et re edit apres!

Edit2: Dans le code de la seconde macro, le With(Nom) n'est pas placé au bon endroit à priori.
Le reste me semble correct, tu as essayé le pas à pas pour voir où ca plante?
17/10/2012, 17h13
apt

Citation:

Envoyé par gbbtt

tu as essayé le pas à pas pour voir où ca plante?

Ici :

Code:

.Range("D4").AutoFill Destination:=[x & EntréeS], Type:=xlFillDefault

Le problème est dans cette syntaxe :

[x & EntréeS]
17/10/2012, 17h49
gbbtt

Et si tu mets comme destination directement ca:

Code:

.Range("D4:D" & sDerLig)

Ca marche?
17/10/2012, 19h12
apt

Ça marche, mais j'aimerais bien travaillé avec des plages nommées.

C'est plus présentable.

Bonjour à tous,

voici une solution :

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
Sub Stocks()
    Dim DerLig As Integer, lDerlig As Integer
    Dim N As String
    '-- Définition des plages nommées dans la feuille "BD"
    With Sheets("BD")
        DerLig = .Range("A" & Rows.Count).End(xlUp).Row
 
        .Range("A1:K" & DerLig).Name = "ZoneExtract"
        .Range("A2:A" & DerLig).Name = "sRéférence"
        .Range("C2:C" & DerLig).Name = "sEtat"
        .Range("D2:D" & DerLig).Name = "sDate"
        .Range("E2:E" & DerLig).Name = "sMouvement"
        .Range("F2:F" & DerLig).Name = "sQuantité"
    End With
 
    With Sheets("Listes")
        lDerlig = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A2:E" & lDerlig).Name = "TabRef"
        .Range("A2:A" & lDerlig).Name = "Ref"
    End With
    N = ActiveSheet.Name
    Call Stock(N)
 
    Application.Calculation = xlCalculationAutomatic
    Columns("A:I").EntireColumn.AutoFit
End Sub
 
Sub Stock(Nom As String)
    Dim sDerLig As Integer
 
    With Sheets(Nom)
 
        '-- Filtre
        .Activate
        [ZoneExtract].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A3:B3"), Unique:=True
 
        '-- Définition des plages nommées dans la& feuille "Nom"
        sDerLig = .Range("A" & Rows.Count).End(xlUp).Row
        x = LCase(Nom)
        .Range("D4:D" & sDerLig).Name = x & "EntréeS"
        .Range("E4:E" & sDerLig).Name = x & "SortieS"
        .Range("F4:F" & sDerLig).Name = x & "StockDispoS"
        .Range("C4:C" & sDerLig).Name = x & "StockInitialS"
        .Range("G4:G" & sDerLig).Name = x & "StockMiniS"
        .Range("H4:H" & sDerLig).Name = x & "DateS"
        .Range("I4:I" & sDerLig).Name = x & "AlerteS"
 
        '-- Ecriture des formules et calcul --'
 
        '-- Formule pour calculer la somme des entrées pour une référence
        .Range(x & "EntréeS").Formula = "=SUMPRODUCT((sRéférence=$A4)*(sEtat=""" & Nom & """)*(sMouvement=""Entrée"")*(sQuantité))"
 
 
        '-- Formule pour calculer la somme des sorties pour une référence
        .Range(x & "SortieS").Formula = "=SUMPRODUCT((sRéférence=$A4)*(sEtat=""" & Nom & """)*(sMouvement=""Sortie"")*(sQuantité))"
 
        '-- Formule pour calculer la quantité en stock pour une référence
        .Range(x & "StockDispoS").Formula = "=C4+(D4-E4)"
 
        '---- Affichage du stock initial correspondant ---
        .Range(x & "StockInitialS").Formula = "=INDEX(TabRef,MATCH($A4,Ref,0),4)"
 
        '---- Affichage du stock mini correspondant ---
        .Range(x & "StockMiniS").Formula = "=INDEX(TabRef,MATCH($A4,Ref,0),5)"
 
        '-- Calcul de la date du dernier mouvement
        .Range(x & "DateS")(1).FormulaArray = "=MAX((sRéférence=$A4)*(sEtat=""" & Nom & """)*sDate)"
        .Range(x & "DateS")(1).AutoFill Range(x & "DateS")
        .Range(x & "DateS").NumberFormat = "dd/mm/yyyy  hh:mm"
 
 
        '-- Derniere colonne (alertes) + MFC
        .Range(x & "AlerteS").Formula = "=IF(" & x & "StockMiniS="""","""",IF(" & x & "StockDispoS <" & x & "StockMiniS,""Attention: Stock bas"",""RAS""))"
 
        With .Range(.Cells(4, 1), .Cells(sDerLig, 9)).Borders
            .LineStyle = xlContinuous
            .Weight = xlHairline
            .ColorIndex = xlAutomatic
        End With
    End With
End Sub