Accélérer macro

**jbgood** · 26/06/2016, 15h58

Bonjour à tous!

Je cherche à cacher des lignes d'une feuille de calcul si en colonne A la valeur de la cellule est égale à "0".
Pour faire cela aujourd'hui j'utilise une fonction "for For Each cellule " puis if cellule.value = .... entrierow.hidden....
Voir le code ci-dessous
Cela fonctionne, cependant la macro mets environ 2 secondes pour s'exécuter. J'aimerai réduire ce temps au maximum de chez maximum

Pour info dans mon fichier j'utilise des noms de plage de cellule "gestionnaire de noms" dans le code envoyé je les ai remplacé par les plages correspondantes

Auriez-vous des suggestions svp ?

Merci d'avance pour votre aide

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
Sub Hide_ligne()
Start = Timer
Application.EnableEvents = False            'activation des procédures événementielles
Application.ScreenUpdating = False          'Désctive le rafraîchissement de l'écran
 
        For Each cellule In Range("A12:A16, A31:A34, A41:A42")
    If cellule.Value = "0" Then cellule.EntireRow.Hidden = True
    If cellule.Value = "1" Then cellule.EntireRow.Hidden = False
Next cellule
 
Application.EnableEvents = True            'activation des procédures événementielles
Application.ScreenUpdating = True          'Désctive le rafraîchissement de l'écran
 
MsgBox "durée du traitement: " & Timer - Start & " secondes"
End Sub

J'ai ajouté en début de code

Code :

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

Application.Calculation = xlCalculationManual

et en fin de code

Code :

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

Application.Calculation = xlCalculationAutomatic

je gagne 0.3 seconde.

Est-il possible décrire différemment le For each cellule et/ou les if qui suivent pour gagner en temps d'exécution?

Merci

**casefayere** · 26/06/2016, 16h35

Bonjour,

les 0 ou 1 sont les seules valeurs de la colonne ?

**jbgood** · 26/06/2016, 16h45

Dans la collone A j'ai soit:
-1 pour visible,
-0 pour cacher
-cellule vide (non traité par la macro)

**casefayere** · 26/06/2016, 16h50

essayes comme ça et dis-moi

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
Dim Tb1, tb2, tb3, x As Long
  Tb1 = Range("A12:A16"): tb2 = Range("A31:A34"): tb3 = Range("A41:A42")
  For x = 1 To UBound(Tb1, 1)
    If Tb1(x, 1) = 0 Then
      Rows(x + 11).Hidden = True
    Else
      Rows(x + 11).Hidden = False
    End If
  Next
  For x = 1 To UBound(Tb1, 2)
    If tb2(x, 1) = 0 Then
      Rows(x + 30).Hidden = True
    Else
      Rows(x + 30).Hidden = False
    End If
  Next
  For x = 1 To UBound(tb3, 1)
    If tb3(x, 1) = 0 Then
      Rows(x + 40).Hidden = True
    Else
      Rows(x + 40).Hidden = False
    End If
  Next

je reviens sur ton premier code, je sui étonné du temps de traitement pour si peu de cellules à traiter, j'ai essayé ton code, j'ai essayé celui-ci

Code :

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

1
2
3
4
5
6
7
  For Each cellule In Range("A12:A16, A31:A34, A41:A42")
    If cellule.Value = "0" Then
      cellule.EntireRow.Hidden = True
    Else
      cellule.EntireRow.Hidden = False
    End If
  Next cellule

je n'ai pas mis

Code :

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

1
2
Application.EnableEvents = False 
Application.ScreenUpdating = False

et le code s'est exécuté instantanément

**jbgood** · 26/06/2016, 17h31

Ma macro durait entre 2 et 1.6 sec j'ai fermé le fichier et réouvert et elle ne dure plus que entre 1.25 et 1 sec... ! je comprend pas tous... bref

La tienne dure entre 0.6 et 0.5 sec,

Je cherchais à réduire ce temps car cette macro est dans une "boucle" du coup sur un test avant j'étais à 32 sec environ et là je passe a 13 sec.

You win!

Par contre le code est un peu plus complexe, tu aurais quelques explications stp?

je regarde ton deuxième code avec le Else je te tiens au courant

**casefayere** · 26/06/2016, 17h50

vraiment, si sur ton original, tu n'as que ces cellules à traiter, je reste étonné, même sans passer par les tableaux

Je cherchais à réduire ce temps car cette macro est dans une "boucle" du coup sur un test avant j'étais à 32 sec environ et là je passe a 13 sec.

peux-tu montrer le code complet
je reviens sur ma macro (1 seule boucle)

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
 Dim Tb1, tb2, tb3, x As Long 'je déclare 3 variables "Tableau"
  'ci-dessous, je les alimente avec les cellules respectives
  Tb1 = Range("A12:A16"): tb2 = Range("A31:A34"): tb3 = Range("A41:A42")
  For x = 1 To UBound(Tb1, 1) 'une boucle qui compare
    If Tb1(x, 1) = 0 Then
      Rows(x + 11).Hidden = True 'si tes plages sont exactement celles décrites _
      donc 12 -1 (x au départ) = 11
    Else
      Rows(x + 11).Hidden = False
    End If
    'et ainsi de suite
    If x < 4 Then
      If tb2(x, 1) = 0 Then
        Rows(x + 30).Hidden = True
      Else
        Rows(x + 30).Hidden = False
      End If
    End If
    If x < 3 Then
      If tb3(x, 1) = 0 Then
        Rows(x + 40).Hidden = True
      Else
        Rows(x + 40).Hidden = False
      End If
    End If
  Next

**casefayere** · 26/06/2016, 18h09

d'après ton code, ce n'est pas sur la boucle que je te propose que tu vas réellement gagner du temps, quoique essayes le dernier (1 seule boucle)
on gagne toujours du temps
je vais donc analyser ton code et si je trouve mieux, te le dirai

**casefayere** · 26/06/2016, 18h44

je ne peux pas vérifier, normal, je n'ai rien à traiter, mais une boucle for n'irait pas plus vite ? est-ce que l'utilisation de "If...Then" n'irai pas plus vite que "Select Case" ?, essayes ce code, lequel, je le répète, n'est pas testé (bien possible qu'il y ait des erreurs, prévois une copie

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
Sub LETSGO1_Click()
  start = Timer
  Application.EnableEvents = False          'activation des procédures événementielles
  Application.ScreenUpdating = False        'Désctive le rafraîchissement de l'écran
  'Application.Calculation = xlCalculationManual
 
  Dim wSh1 As Worksheet, wSh2 As Worksheet, wSh3 As Worksheet
  Dim kR1 As Long, kR2 As Long, k As Long, x As Long
  Set wSh1 = ActiveWorkbook.Sheets("COM")
  Set wSh2 = ActiveWorkbook.Sheets("TOOL")
  Set wSh3 = ActiveWorkbook.Sheets("Q")
  kR1 = wSh1.Range("F3").CurrentRegion.Row  'à toi de voir la bonne colonne
  For x = 3 To kR1
    If wSh1.Cells(x, 22) = "þ" Then    '--- 22e colonne
      wSh2.Range("X_1") = wSh1.Cells(x, 11)
      wSh2.Range("X_2") = wSh1.Cells(x, 12)
      wSh2.Range("X_3") = wSh1.Cells(x, 13)
      wSh2.Range("X_4") = wSh1.Cells(x, 9)
      wSh2.Range(" X_5") = wSh1.Cells(x, 8)
      wSh2.Range("X_F1") = wSh1.Cells(x, 14)
      wSh2.Range("X_U1") = wSh1.Cells(x, 15)
      wSh2.Range("X_S1") = wSh1.Cells(x, 16)
      If wSh1.Cells(x, 15) = "MMQ" And wSh1.Cells(x, 16) = "MMQ" Then
        kR2 = 13
      ElseIf wSh1.Cells(x, 15) = "MMMini/Maxi" And wSh1.Cells(x, 16) = "MMMini/Maxi" Then
        kR2 = 14
      ElseIf wSh1.Cells(x, 15) = "PMini/Maxi" And wSh1.Cells(x, 16) = "PMini/Maxi" Then
        kR2 = 15
      Else          '--- autre cas
        MsgBox vbTab & "  Problème syntaxe commande n° " & Cells(x, 6).Value & vbTab & Chr(10) & Chr(10) & "Vérifiez que la ligne de la commande correspond à un PMX, NF ou NS Semi-Standard et que sa codification est correct." & Chr(10) & Chr(10) & vbTab & "           !!! La procedure doit être stoppé !!!" & vbTab, , "W.G. MultiCommande Erreur"
        Exit Sub
      End If
      For k = 1 To 5
        wSh2.Cells(kR2, 1 + 6 * k) = wSh1.Cells(x, 16 + k)
      Next k
      Call Module1.Hide_ligne3
      Application.EnableEvents = True          'activation des procédures événementielles
      Application.ScreenUpdating = True        'Désctive le rafraîchissement de l'écran
      'Application.Calculation = xlCalculationAutomatic
      'wSh2.PrintPreview          '--- aperçu avant impression
      'wSh3.PrintPreview          '--- aperçu avant impression
      'Call Module1.print pdf
      'wSh2.PrintOut              '--- impression directe
      'wSh3.PrintOut              '--- impression directe
      'Application.EnableEvents = False            'activation des procédures événementielles
      'Application.ScreenUpdating = False          'Désctive le rafraîchissement de l'écran
      'Application.Calculation = xlCalculationManual
    End If
  Next x
  MsgBox "durée du traitement: " & Timer - start & " secondes"
 
  start = Timer
  wSh2.Range("X_F1").Value = "TOTO"
  wSh2.Range("X_U1").Value = "U"
  wSh2.Range("X_S1").Value = "SOSO"
  wSh2.Range("Del_codif").Value = ""
  wSh2.Range("Del_cde").Value = ""
  Call Module1.Hide_ligne3
 
  Worksheets("COM").Activate
  Set wSh1 = Nothing
  Set wSh2 = Nothing
  Set wSh3 = Nothing
 
  Application.EnableEvents = True          'activation des procédures événementielles
  Application.ScreenUpdating = True        'Désctive le rafraîchissement de l'écran
  'Application.Calculation = xlCalculationAutomatic
 
  MsgBox "durée du traitement: " & Timer - start & " secondes"
End Sub

**jbgood** · 26/06/2016, 19h18

Je le test mais il ne trait pas les cellules à copier ...
comme si aucune cellule n'était égale à "þ" dans la 22eme colonne ou que la colonne F était vide....

A moi de voir dans la bonne colonne c'est à dire stp ?

Car F3 correspond à la bonne colonne du moins si j'ai bien compris ...

A mon avis j'ai un souci dans:

Code :

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

1
2
3
  kR1 = wSh1.Range("F3").CurrentRegion.Row  'à toi de voir la bonne colonne
  For x = 3 To kR1
    If wSh1.Cells(x, 22) = "þ" Then    '--- 22e colonne

**casefayere** · 26/06/2016, 19h51

Car F3 correspond à la bonne colonne du moins si j'ai bien compris

pas de problème
j'aimerai que tu vérifies la valeur de kR1 avec un point d'arrêt juste après ça

Code :

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

kR1 = wSh1.Range("F3").CurrentRegion.Row

ensuite, un point d'arrêt sur cette ligne

Code :

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

wSh2.Range("X_1") = wSh1.Cells(x, 11)

si le code ne s'arrête pas à cet endroit, donc problème avec ci-dessus, je suis à l'aveugle

**jbgood** · 26/06/2016, 20h01

je me demandai a quoi servait de mettre le point rouge sur une ligne lol..

1er point d'arret: kr1 = 1

2eme point d'arret : en effet le code ne s'arrête pas....

Je comprend que tu es a l'aveugle si tu veux que je fasse un truc pour te faciliter la tache n'hésite pas.

a toute hazard faudrait pas dire "x as quelque chose" en debut de code...?

**casefayere** · 26/06/2016, 20h18

1er point d'arret: kr1 = 1

donc j'ai fait déjà une erreur à ce stade, essayes avec un "s" après "Row"

Code :

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

kR1 = wSh1.Range("F3").CurrentRegion.Rows + 3

et dis-moi

Je comprend que tu es a l'aveugle si tu veux que je fasse un truc pour te faciliter la tache n'hésite pas.

je te demanderai certainement un fichier bidon structuré de la même façon que l'original

**jbgood** · 26/06/2016, 20h23

essayes avec un "s" après "Row"

Code :

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

kR1 = wSh1.Range("F3").CurrentRegion.Rows + 3

et dis-moi

erreur d'exécution 13
incompatibilité de type

sinon je ne mets pas le s de row mais que je conserve le +3 la macro arrive à
Else 'autre cas
message box......

je te demanderai certainement un fichier bidon structuré de la même façon que l'original

Je te prépare un fichier

**jbgood** · 26/06/2016, 20h48

En espèrent que ca t'aide

**casefayere** · 26/06/2016, 21h08

Donnes-moi du temps, eh oui, il y a le foot et j'ai des invités, et je vois d'autres choses en même temps, patience !!

**jbgood** · 26/06/2016, 21h13

Pas de souci t'inquiet, je comprends tu me répondras quand tu aura un moment.
je me débrouille avec le code que j'ai pour le moment, il n'y a pas d'urgence

Bon match

J'avoue je suis au taquet sur le truc lol , réponds quand tu veux ca peut attendre un autre jour t'inquiet

Je te remercie pour tout ce que tu a déjà fait , bonne soirée

**jurassic pork** · 27/06/2016, 04h13

hello,
jbgood, tu es sûr des temps que tu annonces ? parce que chez moi tes commandes s'effectuent toujours en moins d'une seconde. A moins que tu es un PC nettement moins puissant que le mien, je ne comprend pas cette différence

.
Exemple de temps affiché chez moi pour une commande Let's go de ton classeur :
Nom : temps_macro.png
Affichages : 872
Taille : 11,6 Ko

Note bien l'exposant à la fin de l'affichage de la durée de traitement ce qui vaut : 3,4179 10^-2 secondes = 34,179 ms

Ami calmant, J.P

**jbgood** · 27/06/2016, 19h07

tu es sûr des temps que tu annonces ? parce que chez moi tes commandes s'effectuent toujours en moins d'une seconde. A moins que tu es un PC nettement moins puissant que le mien, je ne comprend pas cette différence

.
Exemple de temps affiché chez moi pour une commande Let's go de ton classeur :
Nom : temps_macro.png
Affichages : 872
Taille : 11,6 Ko

Salut JP?
Ca va?
La macro Let's_GO avait un problème c'est pour ca quelle est super rapide chez toi, celle qui mettait plus de temps environ 7 sec est Let's_GO1. Sur Lets_go1 un j'ai suivit les modif de Dom. Ce qui ralentissait le plus était au niveau du Call Module1.Hide_ligne3() .
avant il y avait:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub Hide_ligne()
Start = Timer
Application.EnableEvents = False            'activation des procédures événementielles
Application.ScreenUpdating = False          'Désctive le rafraîchissement de l'écran
 
        For Each cellule In Range("A12:A16, A31:A34, A41:A42")
    If cellule.Value = "0" Then cellule.EntireRow.Hidden = True
    If cellule.Value = "1" Then cellule.EntireRow.Hidden = False
Next cellule
 
Application.EnableEvents = True            'activation des procédures événementielles
Application.ScreenUpdating = True          'Désctive le rafraîchissement de l'écran

et maintenant:

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Hide_ligne3()
 
  For Each cellule In Range("Hide_fo")
    If cellule.Value = "0" Then
      cellule.EntireRow.Hidden = True
    Else
      cellule.EntireRow.Hidden = False
    End If
  Next cellule
End Sub

Cela + quelques modif au niveau des emplacements des procédures événementielles a divisé réduit considérablement le temps d'exécution je suis passé de plus de 30sec à 7 sec environ

concernant

Note bien l'exposant à la fin de l'affichage de la durée de traitement ce qui vaut : 3,4179 10^-2 secondes = 34,179 ms

Merci de préciser mais j'avais remarqué

Sinon j'avais essayé de mettre des

Code :

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

Application.Calculation = xlCalculationManual

et

Code :

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

Application.Calculation = xlCalculationAutomatic

Mais ça foutai un peu la "M...de" si je peu me permettre a moin que je ne les plaçaient pas au bonne endroit... Bref

En conclusion, je suis satisfait du résultat je vous remercie à tous de votre participation en particulier Dom.

Donc une fois de plus résolue

Mon fichier avance à grand pas et en grande partie à vous

MERCI A TOUS et a bientôt....

**casefayere** · 27/06/2016, 06h01

Bonjour le forum, jurassic pork, jbgood

ton code corrigé si j'ai compris

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
Sub LETSGO_Click()
Start = Timer
Application.EnableEvents = False          'activation des procédures événementielles
Application.ScreenUpdating = False        'Désctive le rafraîchissement de l'écran
 
Dim wSh1 As Worksheet, wSh2 As Worksheet, wSh3 As Worksheet
Dim kR1 As Long, kR2 As Long, k As Long, x As Long
Set wSh1 = ActiveWorkbook.Sheets("COMMANDES")
Set wSh2 = ActiveWorkbook.Sheets("FICHE OUTIL")
Set wSh3 = ActiveWorkbook.Sheets("FICHE QUALITE")
 
kR1 = wSh1.Range("F" & wSh1.Rows.Count).Row
For x = 3 To kR1
  If wSh1.Cells(x, 22) = "þ" Then    '--- 22e colonne
      wSh2.Range("X_numcde") = wSh1.Cells(x, 11)
      wSh2.Range("X_lignecde") = wSh1.Cells(x, 12)
      wSh2.Range("X_datecde") = wSh1.Cells(x, 13)
      wSh2.Range("X_PN") = wSh1.Cells(x, 9)
      wSh2.Range("X_qtécde") = wSh1.Cells(x, 8)
      wSh2.Range("X_Fami") = wSh1.Cells(x, 14)
      wSh2.Range("X_unité") = wSh1.Cells(x, 15)
      wSh2.Range("X_syntaxe") = wSh1.Cells(x, 16)
 
      If wSh1.Cells(x, 15) = "Millimètre" And wSh1.Cells(x, 16) = "Qualité ISO" Then
        kR2 = 13
      ElseIf wSh1.Cells(x, 15) = "Millimètre" And wSh1.Cells(x, 16) = "Mini/Maxi" Then
        kR2 = 14
      ElseIf wSh1.Cells(x, 15) = "Pouce" And wSh1.Cells(x, 16) = "Mini/Maxi" Then
        kR2 = 15
      Else          '--- autre cas
        MsgBox vbTab & "  Problème syntaxe commande n° " & Cells(x, 6).Value & vbTab & Chr(10) & Chr(10) & "Vérifiez que la ligne de la commande correspond à un et que sa codification est correct." & Chr(10) & Chr(10) & vbTab & "           !!! La procedure doit être stoppé !!!" & vbTab, , "W.G. MultiCommande Erreur"
        Exit Sub
      End If
      For k = 1 To 5
        wSh2.Cells(kR2, 1 + 6 * k) = wSh1.Cells(x, 16 + k)
      Next k
 
      Call Module1.Hide_ligne3
 
      Application.EnableEvents = True          'activation des procédures événementielles
      Application.ScreenUpdating = True        'Désctive le rafraîchissement de l'écran
 
      wSh2.PrintPreview          '--- aperçu avant impression
      'wSh3.PrintPreview          '--- aperçu avant impression
      'Call Module1.print pdf
      'wSh2.PrintOut              '--- impression directe
      'wSh3.PrintOut              '--- impression directe
 
      Application.EnableEvents = False            'activation des procédures événementielles
      Application.ScreenUpdating = False          'Désctive le rafraîchissement de l'écran
 
  End If
Next x
MsgBox "durée du traitement: " & Timer - Start & " secondes"
 
Start = Timer
wSh2.Range("X_fami").Value = "Famille d'outil"
wSh2.Range("X_unité").Value = "Unité"
wSh2.Range("X_syntaxe").Value = "Syntaxe Ø"
wSh2.Range("Del_codif").Value = ""
wSh2.Range("Del_cde").Value = ""
 
Call Module1.Hide_ligne3
 
  Worksheets("COMMANDES").Activate
  Set wSh1 = Nothing
  Set wSh2 = Nothing
  Set wSh3 = Nothing
 
  Application.EnableEvents = True          'activation des procédures événementielles
  Application.ScreenUpdating = True        'Désctive le rafraîchissement de l'écran
 
  MsgBox "durée du traitement: " & Timer - Start & " secondes"
End Sub

Méfier-toi, j'ai remarqué que tu n'utilises pas "Option Explicit", tu seras plus sur de tes codes en le spécifiant
Nom : explicit.JPG
Affichages : 780
Taille : 40,3 Ko

Nom : explicit.JPG
Affichages : 780
Taille : 40,3 Ko

**jbgood** · 27/06/2016, 18h38

Salut le forum, Dom

ton code corrigé si j'ai compris

Parfait il fonction comme prévu impect !
Je l'ai comparé avec celui que j'utilise et il n'est pas plus rapide mais ca me permet de voir une autre logique de programmation merci. Je pense que ce qui ralentissait le code était surtout la syntaxe au niveau du montrer cacher. J'avais justement mis des start timer pour détecter quelle parti prenait le plus temps . En modifiant la syntaxe montrer cacher avec le else comme tu me l'as indiqué ça a divisé par deux le temps de cette parti.

Code :

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

1
2
3
4
5
6
7
For Each cellule In Range("A12:A16, A31:A34, A41:A42")
    If cellule.Value = "0" Then
      cellule.EntireRow.Hidden = True
    Else
      cellule.EntireRow.Hidden = False
    End If
  Next cellule