Réduire un code VBA

**apt** · 17/10/2012, 10h47

Bonjour à tous,

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

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
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 :

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
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.

**issoram** · 17/10/2012, 10h50

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.

**apt** · 17/10/2012, 16h46

Bonjour issoram, gbbtt,

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 :

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
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]

**gbbtt** · 17/10/2012, 16h52

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?

**apt** · 17/10/2012, 17h13

Envoyé par gbbtt

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

Ici :

Code :

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

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

Le problème est dans cette syntaxe :

[x & EntréeS]

**gbbtt** · 17/10/2012, 17h49

Et si tu mets comme destination directement ca:

Code :

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

.Range("D4:D" & sDerLig)

Ca marche?

**gbbtt** · 17/10/2012, 10h53

Salut,

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

Code :

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

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 :

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

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

Code :

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

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

Réduire un code VBA [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager