rendre un code VBA plus rapide

[pascal21]

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 21/12/2009 par pascal
'

    With Sheets("Tableau de bord général") 'lignes raboteuses
   Dim i As Integer
   For i = 4 To 40
  If Range("c" & i).Value = 0 Then
Range("q1").Value = Range("r1").Value
   Else
   .Hyperlinks.Add Anchor:=Range("c" & i), Address:=Range("q" & i).Value, _
        SubAddress:=Range("r" & i).Value, TextToDisplay:=Range("p" & i).Value
   End If
  Next i
    End With
    With Sheets("Tableau de bord général")
    Dim a As Integer 'lignes semis
   For a = 42 To 78
  If Range("c" & a).Value = 0 Then
Range("q1").Value = Range("r1").Value
   Else
   .Hyperlinks.Add Anchor:=Range("c" & a), Address:=Range("q" & a).Value, _
        SubAddress:=Range("r" & a).Value, TextToDisplay:=Range("p" & a).Value
   End If
  Next a
    End With
  With Sheets("Tableau de bord général")
     Dim o As Integer 'lignes tracteurs
   For o = 80 To 119
  If Range("c" & o).Value = 0 Then
Range("q1").Value = Range("r1").Value
   Else
   .Hyperlinks.Add Anchor:=Range("c" & o), Address:=Range("q" & o).Value, _
        SubAddress:=Range("r" & o).Value, TextToDisplay:=Range("p" & o).Value
     
   End If
  Next o
    End With
    With Sheets("Tableau de bord général")
     Dim l As Integer 'lignes balayeuses
   For l = 121 To 144
  If Range("c" & l).Value = 0 Then
Range("q1").Value = Range("r1").Value
   Else
   .Hyperlinks.Add Anchor:=Range("c" & l), Address:=Range("q" & l).Value, _
        SubAddress:=Range("r" & l).Value, TextToDisplay:=Range("p" & l).Value
     End If
  Next l
    End With
    With Sheets("Tableau de bord général")
     Dim m As Integer 'lignes semis
   For m = 146 To 200
  If Range("c" & m).Value = 0 Then
Range("q1").Value = Range("r1").Value
   Else
   .Hyperlinks.Add Anchor:=Range("c" & m), Address:=Range("q" & m).Value, _
        SubAddress:=Range("r" & m).Value, TextToDisplay:=Range("p" & m).Value
 
                    
 
 
 
    End If
  Next m
    End With
   
 
    
End Sub

bonjour
comment optimiser ce code pour le rendre plus rapide
cela prends env. 50 sec actuellement
je vois bien que l'on peut modifier la ligne "for I" mais je ne sais quoi y mettre
merci

 

[Roland_M]

Re : rendre un code VBA plus rapide

bonjour

en l'état, plus rapide je sais pas !? mais plus court bien sûr !
si j'ai bien compris !? car pas d'essai possible !

Sub Macro1()
Macro2 4, 40 'lignes raboteuses
Macro2 42, 78 'lignes semis
Macro2 80, 119 'lignes tracteurs
Macro2 121, 144 'lignes balayeuses
Macro2 146, 200 'lignes semis
End Sub
Sub Macro2(L1 As Integer, L2 As Integer)
Dim L As Integer
With Sheets("Tableau de bord général")
 For L = L1 To L2
  If Range("c" & L).Value = 0 Then
     Range("q1").Value = Range("r1").Value
  Else
    .Hyperlinks.Add Anchor:=Range("c" & L), Address:=Range("q" & L).Value, _
     SubAddress:=Range("r" & L).Value, TextToDisplay:=Range("p" & L).Value
  End If
 Next L
End With
End Sub

 

[Roland_M]

Re : rendre un code VBA plus rapide

re

excuses moi j'ai été un peu trop rapide !
j'avais oublié pour la rapidité !
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sub Macro1()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Macro2 4, 40 'lignes raboteuses
Macro2 42, 78 'lignes semis
Macro2 80, 119 'lignes tracteurs
Macro2 121, 144 'lignes balayeuses
Macro2 146, 200 'lignes semis
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Macro2(L1 As Integer, L2 As Integer)
Dim L As Integer
With Sheets("Tableau de bord général")
 For L = L1 To L2
  If Range("c" & L).Value = 0 Then
     Range("q1").Value = Range("r1").Value
  Else
    .Hyperlinks.Add Anchor:=Range("c" & L), Address:=Range("q" & L).Value, _
     SubAddress:=Range("r" & L).Value, TextToDisplay:=Range("p" & L).Value
  End If
 Next L
End With
End Sub

 

[pascal21]

Re : rendre un code VBA plus rapide

bonjour et merci à vous 2
sur le plan de la rapidité c'est roland qui l'emporte