Macro steeds trager wanneer achter elkaar gebruikt

[Peter Bulthuis]

Hoi,

Ik heb sinds kort een gek probleem.
Ik gebruik in Excel een macro die steeds trager wordt wanneer je deze kort achter elkaar gebruikt. Maar wacht je ongeveer een minuut, dan is de normale snelheid weer terug.

Bij de andere macro's in dezelfde sheet heb ik dat probleem overigens niet.

Wat zou het probleem kunnen zijn?

Groet,

Peter Bulthuis

Sub Test()
'
' Filter01 Macro
' De macro is opgenomen op 9-2-2012 door P.Bulthuis.
'

'
On Error GoTo ErrorHandler

    screenupdate = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Selection.Copy
    Range("J6").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("K6").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],SEARCH(""|"",RC[-1],1))"
    Range("A2:R5").Select
    Selection.ClearContents
    Range("K6").Select
    Selection.Copy
    Range("J2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J9").Select
    Range("A9:R2000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Rows("1:2"), Unique:=False
    Range("J2").Select
    Selection.ClearContents
    
    Range("A9:R2000").Sort Key1:=Range("J9"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    
    Range("A2:R8").Select
    Selection.ClearContents
    Range("J8").Select
    Application.Calculation = xlCalculationAutomatic
    screenupdate = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Exit Sub
    
ErrorHandler:
   Range("J2").Select
    Selection.ClearContents
    Range("K6").Select
    Selection.ClearContents
    Range("J6").Select
    Selection.Copy
    Range("J2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("J9").Select
    Range("A9:R2000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Rows("1:2"), Unique:=False
    Range("J2").Select
    Selection.ClearContents
    Range("J6").Select
    Selection.ClearContents
    Exit Sub
   End Sub

 

[Warme bakkertje]

Begin al eens met al die Select en Selection eruit te werken.

 

[Wigi]

Bvb.

Dit:

wordt:

Range("J2").Value = Range("K6").Value

 

[Wigi]

Bvb.

Dit:

Range("K6").Select
    Selection.Copy
    Range("J2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

wordt:

Range("J2").Value = Range("K6").Value

 

[Tent84]

Reden vertraging

Een kortere en directe schrijfwijze zou inderdaad al schelen in de leesbaarheid van je macro (ook voor anderen). Als ik je code goed lees dan laat je de MATCH-formule staan. MATCH(vergelijken) of VLOOKUP(vert.zoeken) zijn een van de meest vertragende formules die ik ken.

Dit wordt duidelijk als je deze formule voor meerdere rijen gaat gebruiken en Auto-calculatie aanstaat (deze zet je namelijk halverwege je macro weer aan). Bij elke celwijziging wordt de berekening opnieuw uitgevoerd. Oplossing is om het (berekende) resultaat te kopieren en opslaan als waarden (Paste values).