Optimisation d'un code

Le 03/05/2012 à 10:23

Bonjour à tous,

Jusqu'à maintenant j'utilisais le code 1 dans un sub, qui avait un temps d'exécution d'environ 1s. J'ai du passer au code 2 pour pouvoir rajouter des événements sur une feuille (le code 1 les supprimait à chaque fois). Seulement voilà, le code 2 doit être vraiment très mal écrit puisque j'ai un temps d'exécution d'environ 34s. Etant novice en VBA, j'aimerais savoir comment m'y prendre pour réctifier tout ça.

Par contre, je m'excuse de ne pas pouvoir joindre le fichier qui est confidentiel.

Je vous remercie d'avance pour votre aide,

Vince

code 1

Application.ScreenUpdating = False

Sheets("Sélection des activités").Select

Application.DisplayAlerts = False 'pour faire une suppression automatique sans message de confirmation

For Each ws In Worksheets

If ws.Name = "Annexe" Then

Sheets("Annexe").Delete

End If

Next

Application.DisplayAlerts = True

Sheets("BibliRisques").Select

ActiveSheet.Copy After:=Sheets(ActiveWorkbook.Sheets.Count)

ActiveSheet.Name = "Annexe"

Columns("A:A").EntireColumn.Hidden = True

Columns("B:B").EntireColumn.Hidden = True

Columns("C:C").EntireColumn.Hidden = True

Columns("F:F").ColumnWidth = 20

Range("F3").Value = "Photo"

For i = 4 To 7 'cache les lignes qui ne comportent aucun risque particulier

Rows(i).Hidden = True

Next i

For i = 9 To 11

Rows(i).Hidden = True

Next i

For i = 14 To 19

Rows(i).Hidden = True

Next i

For i = 23 To 30

Rows(i).Hidden = True

Next i

Rows(32).Hidden = True

Rows(35).Hidden = True

Rows(37).Hidden = True

Rows(39).Hidden = True

Rows(41).Hidden = True

For i = 43 To 153

Rows(i).Hidden = True

Next i

For i = 156 To 161

Rows(i).Hidden = True

Next i

Rows(163).Hidden = True

Application.ScreenUpdating = True

code 2

If Worksheets("Analyse des Risques").Visible = False Then

MsgBox ("Veuillez passer d'abord par l'analyse des risques")

Else

Application.ScreenUpdating = False

Worksheets("Annexe").Visible = True

Sheets("Annexe").Select

Cells.Select

Selection.Delete

Sheets("Analyse des Risques").Select

Cells.Select

Selection.Copy

Sheets("Annexe").Select

Cells.Select

ActiveSheet.Paste

Columns("A:A").EntireColumn.Hidden = True

Columns("B:B").EntireColumn.Hidden = True

Columns("C:C").EntireColumn.Hidden = True

Columns("D:D").EntireColumn.Hidden = True

Columns("H:H").EntireColumn.Hidden = True

Columns("F:F").ColumnWidth = 25

Range("F3").Value = "Photo"

For i = 4 To 7 'cache les lignes qui ne comportent aucun risque particulier

Rows(i).Hidden = True

Next i

For i = 9 To 11

Rows(i).Hidden = True

Next i

For i = 14 To 19

Rows(i).Hidden = True

Next i

For i = 23 To 30

Rows(i).Hidden = True

Next i

Rows(32).Hidden = True

Rows(35).Hidden = True

Rows(37).Hidden = True

Rows(39).Hidden = True

Rows(41).Hidden = True

For i = 43 To 153

Rows(i).Hidden = True

Next i

For i = 156 To 161

Rows(i).Hidden = True

Next i

Rows(163).Hidden = True

Application.ScreenUpdating = True

Le 03/05/2012 à 11:04

Bonjour,

Tu peux essayer un truc comme ça :

Sub code2()
If Worksheets("Analyse des Risques").Visible = False Then
  MsgBox ("Veuillez passer d'abord par l'analyse des risques")
Else
  Application.ScreenUpdating = False
  On Error GoTo GESTERR
  Application.EnableEvents = False

  Sheets("Annexe").Cells.Delete
  Sheets("Analyse des Risques").Cells.Copy Range("A1")

  For i = 1 To 4:    Columns(i).Hidden = True:  Next

  Columns(6).ColumnWidth = 25
  Range("F3") = "Photo"

  For i = 4 To 7:  Rows(i).Hidden = True:  Next
  For i = 9 To 11:  Rows(i).Hidden = True:  Next
  For i = 14 To 19:  Rows(i).Hidden = True:  Next
  For i = 23 To 30:  Rows(i).Hidden = True:  Next

  Rows(32).Hidden = True
  Rows(35).Hidden = True
  Rows(37).Hidden = True
  Rows(39).Hidden = True
  Rows(41).Hidden = True

  For i = 43 To 153:  Rows(i).Hidden = True:  Next
  For i = 156 To 161:  Rows(i).Hidden = True:  Next

  Rows(163).Hidden = True
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End If
Exit Sub

GESTERR:
Application.EnableEvents = True
End Sub

A+

Le 03/05/2012 à 11:30

Bonjour

Un essai

Sub code2()
  If Worksheets("Analyse des Risques").Visible = False Then
    MsgBox ("Veuillez passer d'abord par l'analyse des risques")
  Else
    Application.ScreenUpdating = False
    With Sheets("Annexe")
      .Cells.Delete
      Sheets("Analyse des Risques").Cells.Copy Destination:=.Range("A1")
      .Range("A:D,H:H").EntireColumn.Hidden = True
      .Columns("F").ColumnWidth = 25
      .Range("F3").Value = "Photo"
      .Range("A4:A7,A9:A11,A14:A19,A23:A30,A2,A35,A37,A39,A45:A153,A156:A161,A163").EntireRow.Hidden = True
    End With
    Application.ScreenUpdating = False
  End If
End Sub
Le 03/05/2012 à 12:13

Merci beaucoup pour vos réponses!! Plus rapide et bien plus clairs

Rechercher des sujets similaires à "optimisation code"