Optimisation d'une macro

**syl150** · 10/02/2016, 15h05

Bonjour a tous

Je viens de créer une macro par "tâtonnement" qui me permet pour chaque ligne d'un tableau de saisie de commande (commande CETA) d'extraire uniquement les produits présents. Ainsi j'obtiens un "bon de livraison" en aperçu avant impression pour chaque client avec les seuls produits commandé.
Cependant cette macro est très lente et malgré les discussions sur le sujet dans ce forum je n'arrive pas à l’accélérer. J'ai bien essayé d'enlever les "select" mais les "SpecialCells(xlCellTypeVisible)" me pose problème.

Voici la macro:

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
Sub essai()
Application.ScreenUpdating = False
 
 
For i = 3 To Sheets("Commande CETA").[A65000].End(xlUp).Row
Range("compteur") = i - 2
 
Sheets("Feuil2").Range("C6:D150").ClearContents
 
Sheets("Commande CETA").Select
ActiveSheet.Calculate
If Cells(i, "B") <> 0 Then
Range("C" & i, "DP" & i).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Worksheets("Feuil2").Select
Range("D6").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
Sheets("Commande CETA").Select
Range("Produit").SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Worksheets("Feuil2").Select
Range("C6").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
 
Range("C5").AutoFilter Field:=2, Criteria1:="<>"
 
 
Sheets("Feuil2").PrintPreview
End If
Next
Application.ScreenUpdating = True
 
End Sub

Je joins également le fichier (le bouton noir de la feuill2 lance la macro)Doc tranport2.xlsm

Pourriez vous m'indiquer la démarche a suivre.

Merci

**bpascal123** · 10/02/2016, 15h22

Il y a en effet quelques améliorations possibles

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
Sub essai()
 
'Application.ScreenUpdating = False
 
with application
.screenupdating= false
.displayalerts=false
.calculation=xlmanual 'commente si tu as besoin des calculs en temps réel
end with
 
dim feuil_CETA as worksheet
dim feuil_2 as worksheet
dim r as range
dim der_lig as long
 
with thisworkbook
set feuil_CETA = .worksheets("Commande CETA")
set feuil_2 = .worksheets("Feuil2")
end with
 
with feuil_CETA
 
der_lig = .cells(.rows.count, 1).end(xlup).row
 
For i = 3 To der_lig
.Range("compteur") = i - 2 'feuille CETA?
 
'feuil_2.activate en cas de bug
feuil_2.Range("C6150").ClearContents
 
.activate 'feuil commande CETA, évite Select qui est couteux
.calculate 'très couteux si la feuille a beaucoup de formules, c'est mieux de lancer calculate en fin de script
 
If .Cells(i, "B") <> 0 Then
 
set r = .range("C" &i, "DP" &i)
with r.SpecialCells(xlCellTypeVisible)
.copy feuil_2.range("D6")
.copy feuil_2.range("C6")
end with
 
.Range("C5").AutoFilter Field:=2, Criteria1:="<>"
 
feuil_2.activate 'en cas de bug
feuil_2.PrintPreview 'JE NE SUIS PAS SURE DE COMPRENDRE CETTE INSTRUCTION (elle prévisualise la feuille à l'intérieur de la boucle???) Ne faudrait-il pas la sortir de la boucle FOR?
End If
Next i
end with 'feuil_CETA
 
'Application.ScreenUpdating = True
 
with application
.screenupdating= true
.displayalerts=true
.calculation=xlautomatic 'commente si tu as besoin des calculs en temps réel
end with
 
End Sub

Pascal

**syl150** · 10/02/2016, 16h06

Merci pour cette réponse.

En fait le but de la macro est au final d'imprimer les "bon de transport" un par un mais pour l'instant j'ai mis l'instruction feuil_2.PrintPreview pour ne pas imprimer à chaque test. Je remplacerai une fois la macro terminée par Printout.

Cependant je viens de tester le code modifié et la boucle ne se fait pas. J'ai toujours le même numéro de client avec aucun produit d'afficher.
Par ailleurs dans ce code je ne vois pas comment la transposition d'horizontale en verticale a lieue?

PS :dans mon code un smiley s'était glissé, il faillait lire

Code :

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

Sheets("Feuil2").Range("C6:D150").ClearContents

Merci

**AlainTech** · 10/02/2016, 20h56

Envoyé par syl150

PS :dans mon code un smiley s'était glissé, il faillait lire Sheets("Feuil2").Range("C6

150").ClearContents

Bonjour,

Quand on utilise les balises [code], on n'a pas ce souci.

**bpascal123** · 10/02/2016, 23h15

oops, je n'ai pas vu l'argument .transpose de la méthode pastespecial.

Dans ce cas, il faut modifier le script que j'ai posté à la ligne 36

Code :

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

1
2
3
4
5
set r = .range("C" &i, "DP" &i)
with r.SpecialCells(xlCellTypeVisible)
.copy feuil_2.range("D6")
.copy feuil_2.range("C6")
end with

Les méthodes copy vont se faire sur 2 lignes, je ne sais pas si ça fonctionne sur une ligne, mais de mémoire ça doit ressembler à quelque chose comme ça

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
set r = .range("C" &i, "DP" &i)
with r.SpecialCells(xlCellTypeVisible)
.select
.selection.copy
feuil_2.range("D6").Select
selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
 
feuil_2.range("C6").Select
selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
end with

C'est un script comme ça sans tester sous excel. Il y a très certainement des ajustements.

**syl150** · 12/02/2016, 11h44

Merci pour vos réponses, j'essaye de me débrouiller avec ça et je vous retiens au courant.

**syl150** · 17/02/2016, 21h04

Bonjour

Merci pour votre aide, j'ai réussi à obtenir une macro fonctionnelle.

J'ai encore une petite question d'optimisation. Est-il possible d'accélérer la macro suivante dans laquelle il y a la fonction Vlookup et la fonction Concatener.

Code :

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

1
2
3
4
5
6
7
8
 
For ii = 10 To derlig3
With feuil_doc
    .Range("C" & ii).Value = (WorksheetFunction.VLookup(.Range("A" & ii).Value, Sheets("Produits").Range("Produits"), 3, False)) * Range("B" & ii)
    .Range("D" & ii).Value = (WorksheetFunction.VLookup(.Range("A" & ii).Value, Sheets("Produits").Range("Produits"), 11, False)) * Range("C" & ii)
    .Range("E" & ii).Value = (WorksheetFunction.VLookup(.Range("A" & ii).Value, Sheets("Produits").Range("Produits"), 2, False)) & " x " & (Range("B" & ii) / (WorksheetFunction.VLookup(.Range("A" & ii).Value, Sheets("Produits").Range("Produits"), 2, False)))
    .Range("F" & ii).Value = (WorksheetFunction.VLookup(.Range("A" & ii).Value, Sheets("Produits").Range("Produits"), 12, False)) & " - " & (WorksheetFunction.VLookup(.Range("A" & ii).Value, Sheets("Produits").Range("Produits"), 5, False)) & " - " & (WorksheetFunction.VLookup(.Range("A" & ii).Value, Sheets("Produits").Range("Produits"), 6, False)) & " - " & (WorksheetFunction.VLookup(.Range("A" & ii).Value, Sheets("Produits").Range("Produits"), 7, False))
End With

Merci

**bpascal123** · 17/02/2016, 21h33

Bonjour,

Tu peux référencer la plage de données "Produits" au début du script avec:

Code :

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

1
2
dim rg_Produits as range
set rg_Produits = thisworkbook.worksheets("Produits").range("Produits")

et de mettre la plage dans le script que tu veux optimiser

Code :

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

1
2
3
4
5
6
With feuil_doc
    .Range("C" & ii).Value = (WorksheetFunction.VLookup(.Range("A" & ii).Value, rg_Produits, 3, False)) * Range("B" & ii)
    .Range("D" & ii).Value = (WorksheetFunction.VLookup(.Range("A" & ii).Value, rg_Produits, 11, False)) * Range("C" & ii)
    .Range("E" & ii).Value = (WorksheetFunction.VLookup(.Range("A" & ii).Value, rg_Produits, 2, False)) & " x " & (Range("B" & ii) / (WorksheetFunction.VLookup(.Range("A" & ii).Value, rg_Produits, 2, False)))
    .Range("F" & ii).Value = (WorksheetFunction.VLookup(.Range("A" & ii).Value, rg_Produits, 12, False)) & " - " & (WorksheetFunction.VLookup(.Range("A" & ii).Value, rg_Produits, 5, False)) & " - " & (WorksheetFunction.VLookup(.Range("A" & ii).Value, rg_Produits, 6, False)) & " - " & (WorksheetFunction.VLookup(.Range("A" & ii).Value, rg_Produits, 7, False))
End With

et en fin de code

Code :

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

set rg_Produits = nothing

mais ce n'est pas indispensable

Autre optimisation (accessoire):

Le feuil_doc.Range("C" & ii).Value ainsi que tous les autres peuvent être remplacés par une référence unique sur une plage de données, ex.:

Code :

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

set rg_fdoc = feuil_doc.range("A1")

et ensuite dans le script ci-dessus, tu appliques la méthode offset, pour la première ligne dans la boucle, ça donnerait:

Code :

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

rg_fdoc.offset(ii,3) = (WorksheetFunction.VLookup(.rg_fdoc.offset(ii,) , rg_Produits, 3, False)) * rg_fdoc.offset(ii,1)

C'est ce que je peux voir comme principales optimisations, il doit y en avoir d'autres s'ils suscitent la curiosité des experts qui te lisent.

Cordialement

Pascal

**patricktoulon** · 17/02/2016, 22h06

bonsoir tous les 2
ôtez moi le doute

r a bien 2 cellules et non pas la ligne entière de C a DP

Code :

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

1
2
3
4
5
set r = .range("C" & i ,"DP" & i)'comme ca la plage r contiens que 2 cellules 
with r.SpecialCells(xlCellTypeVisible)
.copy feuil_2.range("D6")
.copy feuil_2.range("C6")
end with

SI C EST PAS LE CAS VOUS AVEZ TOUT FAUX
SE SERAIT PLUTOT

Code :

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

1
2
3
set r = .range("C" & i  ":DP" & i)' comme ca r contiens toutes les cellules de C à DP

ce qui justifierait le xltype visible dans la sélection

**syl150** · 17/02/2016, 22h26

r a bien la ligne entière.
La copie a bien lieue de C à DP avec l'expression ("C" & i ,"DP" & i) alors que ("C" & i ":DP" & i) m'indique "erreur de syntaxe".

Merci

**patricktoulon** · 18/02/2016, 01h33

autant pour moi
la syntaxe c'est ("C" & i & ":DP" & i).
mais si tu me dis que ta version avec la virgule prends toute la ligne ton excel et ton VBA SONT EXOTIQUES

PAR CE QUE CHEZ MOI C EST TA VERSION QUI BUGUE DU MOINS ELLE ME DONNE Cx ET DPx (2 CELLULES )

EN GENERAL ON SE SERT DE LA FORMULE AVEC LA VIRGULE POUR LES PLAGES NON CONTIGUES

exemple1

set r= .range("A1","C3","H15" )--> 3 cellule

exemple2
set r= .range("A1:H15")---> toutes les cellules de a1 à h15

ma foi c'est bizare

Optimisation d'une macro

Macros et VBA Excel

Discussions similaires

Partager

Partager