Excel Makro wird immer langsamer

GhettoNerd

Ensign
Registriert
Mai 2006
Beiträge
241
Hi

Hab n Makro geschrieben, wo mir von einer Tabelle per Spezialfilter 4 Tabellen auf 4 Tabellenblätter ausgeworfen werden.

Hab das jetzt paar Mal getestet und es wird von Mal zu Mal langsamer. Wie kann das sein? Ist der Code schlecht? Hab n bissl recherchiert und ich glaube "Select" ist schlecht für die performance?

Code:
Sub POP_Tabellen_Filtern()
'
' Makro1 Makro
'


'
   
   
Dim lngLastRow As Long




lngLastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
   
    Application.CutCopyMode = False
    Application.CutCopyMode = False
   
        Sheets("1").Select
        Range("A1").Select
               
   
        Sheets("Sheet1").Range("A1:AR" & lngLastRow).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Kriterien").Range("A2:A3"), CopyToRange:=Range("A1") _
        , Unique:=False


        Sheets("2").Select
        Range("A1").Select




        Sheets("Sheet1").Range("A1:AR" & lngLastRow).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Kriterien").Range("B2:B3"), CopyToRange:=Range("A1") _
        , Unique:=False
       
        Sheets("3").Select
        Range("A1").Select
       
        Sheets("Sheet1").Range("A1:AR" & lngLastRow).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Kriterien").Range("C2:C3"), CopyToRange:=Range("A1") _
        , Unique:=False
       
        Sheets("4").Select
        Range("A1").Select
       
        Sheets("Sheet1").Range("A1:AR" & lngLastRow).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Kriterien").Range("D2:D3"), CopyToRange:=Range("A1") _
        , Unique:=False


End Sub
 
Aktualisierung zu Beginn deaktivieren, am Ende wieder aktivieren?

Code:
Application.ScreenUpdating = False
...
Application.ScreenUpdating = True
 
Danke Nöörd,

dadurch ist es von 3:30 auf 0:15 schneller geworden! :D Wünschenswert wären 2-3 Sekunden, aber immerhin.
 
  • Gefällt mir
Reaktionen: nöörd
Zurück
Oben