Macro qui ralentit

Version imprimable

Macro qui ralentit

Bonjour,

Je me tourne vers vous car j'ai un souci avec une macro. Le but de celle-ci est simplement d'afficher et masquer des lignes en fonction de la présence de données dans certaines cellules.
En elle-même, elle fonctionne très bien et, au début, elle fonctionnait rapidement (qq secondes), mais maintenant, elle met près de 3mn à tourner alors qu'elle est franchement basique. Je vous laisse en juger :
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 Private Sub Workbook_Open() Dim i As Long i = 3 Do While i <= 89 ThisWorkbook.Sheets("ACTIVITE COMMERCIALE").Cells(i, 1).EntireRow.Hidden = False i = i + 1 Loop i = 3 Do While i <= 29 If ThisWorkbook.Sheets("ACTIVITE COMMERCIALE").Cells(i, 1).Value = "" Then ThisWorkbook.Sheets("ACTIVITE COMMERCIALE").Cells(i, 1).EntireRow.Hidden = True End If i = i + 1 Loop i = 33 Do While i <= 59 If ThisWorkbook.Sheets("ACTIVITE COMMERCIALE").Cells(i, 1).Value = "" Then ThisWorkbook.Sheets("ACTIVITE COMMERCIALE").Cells(i, 1).EntireRow.Hidden = True End If i = i + 1 Loop i = 63 Do While i <= 89 If ThisWorkbook.Sheets("ACTIVITE COMMERCIALE").Cells(i, 1).Value = "" Then ThisWorkbook.Sheets("ACTIVITE COMMERCIALE").Cells(i, 1).EntireRow.Hidden = True End If i = i + 1 Loop End Sub
Je ne m'explique pas pourquoi elle est devenue si lente. Aucune modification n'a été apportée sur ce fichier. La seule modification de près ou de loin est que le répertoire dans lequel il se trouve a été sécurisé : Il n'est plus en accès public mais je suis désormais le seul autorisé (en sus des administrateurs) à pouvoir le visualiser et le modifier.

A noter que la première instruction, sur laquelle il n'y a pas de condition :
Code:

1 2 3 4 Do While i <= 89 ThisWorkbook.Sheets("ACTIVITE COMMERCIALE").Cells(i, 1).EntireRow.Hidden = False i = i + 1 Loop
met déjà plus d'une minute à touner 8O

Si quelqu'un a une idée...

Merci d'avance

18/06/2010, 10h37
Didier Gonard
Bonjour,

As-tu réessayé de mettre une copie du fichier sur un répertoire normal et voir si la vitesse redevient normale, ça te donnera déjà la raison ou non de la cause à rechercher...

Pour ceci :
Code:

1 2 3 4 Do While i <= 89 ThisWorkbook.Sheets("ACTIVITE COMMERCIALE").Cells(i, 1).EntireRow.Hidden = False i = i + 1 Loop
la boucle est inutile, vois directement du genre :

Code:

....Range("A3:A88").EntireRow.Hidden = False

cordialement,

Didier
18/06/2010, 10h44
TomDuBouchon

Bonjour Ormonth,

Tout d'abord, merci pour la première instruction, c'est vrai que c'est plus simple et à l'exécution c'est instantané. Je gagne donc au moins ça.

Pour ce qui est des droits, le problème c'est que les cellules sur lesquelles sont effectuées les tests sont alimentés par d'autres fichiers excel. Il faut donc que je vois avec l'administrateur réseau pour qu'il repasse le dossier en public.

Je fais donc ça, je teste et je reviens sur le forum.

Bonjour,
avec ça tu vas aussi gagner beaucoup de temps :
Code:

1 2 3 4 5 6 7 Private Sub Workbook_Open() Application.ScreenUpdating = False ... ton code Application.ScreenUpdating = True End Sub

18/06/2010, 11h51
TomDuBouchon

Bonjour,

J'aurais dû précisé que j'avais déjà testé cette option... Sans succès.

Mais merci pour cette proposition.

Bonjour

En passant par un tableau et en faisant le hidden=false et hidden=true d'un coups et non un par un tu devrais gagner beaucoup de temps.

je l'ai testé et c'est instantané

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Private Sub Workbook_Open()
Dim tab1() As Variant, plage As Range, i As Long
Rows("1:89").EntireRow.Hidden = False
With ThisWorkbook.Sheets("ACTIVITE COMMERCIALE")
  tab1 = .Range("A1:A89").Value
  For i = LBound(tab1) To UBound(tab1)
    If (i > 2 And i <= 29) Or (i > 32 And i <= 59) Or (i > 62 And i <= 89) Then
      If tab1(i, 1) = "" Then
        If plage Is Nothing Then
          Set plage = .Cells(i, 1)
        Else
          Set plage = Union(plage, .Cells(i, 1))
        End If
      End If
    End If
  Next
  .Range(plage.Address).EntireRow.Hidden = True
End With
End Sub

18/06/2010, 16h09
TomDuBouchon

:king: ENORME !!! :king:

Un grand grand merci zyhack ! Ca fonctionne nickel, et c'est effectivement instantané... Tu me retires une bonne épine du pied !

Par contre, je ne sais pas si le problème venait des droits sur le répertoire car je n'ai pas réussi à joindre mon administrateur réseau. Si j'effectue le test, je viendrais poster le résultat dans le cas où cela puisse intéresser quelqu'un.

Merci encore à tous les participants :mrgreen: