Code versnellen

[wieter]

Met de mogelijkheden van mijn pc , duurt onderstaande code zeer lang.
Manuele calculatie = uitgeschakeld om de actie te versnellen.
Toch duurt het nog 1.5 minuut voor de 440 regels doorlopen zijn.

Is er een mogelijkheid om de code te versnellen?

Private Sub CommandButton1_Click()

'uitschakelen screenupdate en automatische berekening
    Application.ScreenUpdating = False
    varCalculation = Application.Calculation
    Application.Calculation = xlCalculationManual

For r = 3 To 440
If Range("U" & r).Value <> "" And Range("U" & r).Value < "6" Then
Range("E" & r).Value = Range("AG4").Value: Range("L" & r).Value = Range("AH4").Value
End If
Next r

'Wat uitgeschakeld was terug inschakelen
    Application.ScreenUpdating = True
    Application.Calculation = varCalculation
End Sub

 

[wampier]

Geen idee waarom het zo langzaam zou zijn. Tenzij er iets specifieks mis gaat dat ik niet direct zie zou dit niet meer dan 10 seconden moeten nemen, volgens mij.

De code kan wel efficiënter door het gebruik van "CELLS" en het vastzetten van de vervangende waarden AG4 en AH4. Of dat werkelijk veel gaat besparen kan ik niet voorspellen. Volgens mij is dit ongeveer equivalent:

vast1 = [ag4]
vast2 = [ah4]
for r = 3 to 440
   if cells(r, 21) <> "" and cells (r,21) < 6 then
      cells(r,5) = vast1
      cells(r,12) = vast2
   end if
next r

 

[wieter]

Bedankt voor je antwoord, Wampier
Jou alternatief levert geen sneller resultaat, het blijft ongeveer 1.5 min. duren.

 

[wampier]

Heb je nog andere macro's? anders kun je ook events nog uitschakelen (bijvoorbeeld on_change etc)

 

[Elsendoorn2134]

Wieter,

Ik vermoed dat je macro niet het probleem is. Kan het zijn dat je bestand een zeer groot aantal formules bevat?
Dan kan dat het probleem zijn. Als je namelijk de Calculation weer aan zet gaat Excel ieder formule opnieuw berekenen
dit kan enige tijd kosten waardoor je macro erg lang lijkt te lopen.

Je kunt dit testen door gebruik te maken van onderstaande code:

Public Sub Test33()
Dim Start As Single
Start = Timer
    
Application.ScreenUpdating = False
varCalculation = Application.Calculation
Application.Calculation = xlCalculationManual

Debug.Print "Calculatie uit na " & Timer - Start
For r = 3 To 440
    If Range("U" & r).Value <> "" And Range("U" & r).Value < "6" Then
        Range("E" & r).Value = Range("AG4").Value
        Range("L" & r).Value = Range("AH4").Value
    End If
Next r

Debug.Print "Macro klaar na " & Timer - Start
'Wat uitgeschakeld was terug inschakelen
Application.ScreenUpdating = True
Application.Calculation = varCalculation
Debug.Print "Calculatie aan na " & Timer - Start
End Sub

Mocht dit niet het geval zijn kijk dan even of er misschien nog een ander macro actief kan zijn.
Denk bijvoorbeeld aan de worksheet_change macro.

Veel Succes.

 

[wieter]

Ja! Dat was het probleem.
Het bestand barst van de formules.
Ik wist niet dat na opnieuw aanzetten van "autom. berekening",
excel toch nog alle formules zou herberekenen.
Hiermee is mijn vraag beantwoord.
Bedankt Elsendoorn