Lange Laufzeit trotz EnableEvents
15.01.2013 11:26:52
Florian
folgendes Problem:
Ich habe eine recht umfangreiche Tabelle (~30 Spalten, >10.000 Zeilen), die mit einem Autofilter versehen ist. Über ein Worksheet_Calculate werden die Tabellenüberschriften formatiert (Zeile 5, damit man auf einen Blick erkennt, wo Filter gesetzt sind). Außerdem können Filter durch Tippen in der Zeile 3 gesetzt werden, funktioniert über dasselbe Makro.
Das Ganze ist viel zu langsam, trotz screenupdating, enableevents und calculation.
Ich kann mir nur noch zwei weitere "Langsammacher" denken:
- In der Tabelle sind fünf Spalten mit bedingten Formatierungen versehen
- In der Arbeitsmappe gibt es ~30 Namensbezüge, die per Bereich.verschieben flexibel sind.
Können das die Bremsen sein? Habt Ihr sonst irgendwelche Tips?
Vielen Dank schonmal,
Florian
Private Sub Worksheet_Calculate()
' Sofortausstieg, wenn nicht Sheet Masterliste_U7 aktiviert
If ActiveSheet.Name "Masterliste_U7" Then End
On Error GoTo err_exit
status = "stabil"
Dim rngMarkiert As Range
Set rngMarkiert = ActiveSheet.Range(Selection.Address) 'Auslesen der Range, damit später wieder _
selbe Range markiert werden kann
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For i = 1 To 27
If Sheets("Filter").Cells(3, i).Value Sheets("Masterliste_U7").Cells(3, i).Value Then
status = "instabil"
spalte = i
End If
Next i
If status "stabil" Then
'Tritt dann auf, wenn Filter in Zeile 3 (grün unterlegt) gesetzt oder gelöscht wurden
'FILTER PER TASTATUR
'Test, Ob Zelle leer oder nicht
If Cells(3, spalte).Value = "" Then
' FILTER WURDE GELÖSCHT
'Zelle ist leer, Filter löschen
ActiveSheet.Range("Opportunities").AutoFilter Field:=spalte
'Farbe zurücksetzen
Cells(3, spalte).Interior.Color = 12379351 'Freitext - Hintergrundfarbe
Cells(5, spalte).Font.Color = 16777215 'Filter - Schrift
Cells(5, spalte).Interior.Color = 11272192 'Filter - Hintergrundfarbe
Else
' FILTER WURDE GESETZT
'Zelle ist gefüllt, Filter setzen
ActiveSheet.Range("Opportunities").AutoFilter Field:=spalte, Criteria1:=Cells(3, spalte) _
, Operator:=xlAnd
'Farbe setzen
Cells(3, spalte).Interior.Color = 5296274 'Freitext - Hintergrundfarbe
Cells(5, spalte).Interior.Color = 255 'Filter - Schrift
Cells(5, spalte).Font.Color = -16711681 'Filter - Hintergrundfarbe
End If
Cells(3, spalte).Select
Else
'Tritt dann auf, wenn Filter in Zeile 5 (blau unterlegt) gesetzt oder gelöscht wurden
'FILTER PER MAUS
Dim filterbeschreibung As String
With Worksheets("Masterliste_U7")
If .AutoFilterMode Then
'Filter Spalte für Spalte durchgehen:
For spalte = 1 To .AutoFilter.Filters.Count
operator_Nr = ""
Kriterium1 = ""
Kriterium2 = ""
filterbeschreibung = ""
With .AutoFilter.Filters(spalte)
If .On Then
'Kriterium1 = .Criteria1
If .Operator Then
operator_Nr = .Operator
End If
End If
End With
'Operator auslesen
Select Case operator_Nr
Case 3, 4, 7, 8, 10, 11: filterbeschreibung = "dynamisch"
Case Else 'Mehrfach und einfach, test auf zweite Kondition
With .AutoFilter.Filters(spalte)
If .On Then Kriterium1 = .Criteria1
End With
With .AutoFilter.Filters(spalte)
If .On Then
If .Operator Then Kriterium2 = .Criteria2
End If
End With
If Kriterium2 "" Then filterbeschreibung = "dynamisch"
If filterbeschreibung = "" Then filterbeschreibung = Kriterium1
End Select
' 1 und =xland
' 2 oder =xlor
' 3 Top10 =xlTop10Items
' 4 Worst10 =xlBottom10Items
' 7 Mehrfach =xlFilterValues
' 8 Farbe =xlFilterCellColor
'10 Symbol =xlFilterIcon
'11 Dynamisch =xlFilterDynamic
If filterbeschreibung "" Then
' FILTER WURDE GESETZT
If filterbeschreibung "dynamisch" Then Cells(3, spalte) = filterbeschreibung
'Farbe setzen
Cells(3, spalte).Interior.Color = 5296274 'Freitext - Hintergrundfarbe
Cells(5, spalte).Interior.Color = 255 'Filter - Schrift
Cells(5, spalte).Font.Color = -16711681 'Filter - Hintergrundfarbe
Else
' FILTER WURDE GELÖSCHT
Cells(3, spalte) = ""
'Farbe zurücksetzen
Cells(3, spalte).Interior.Color = 12379351 'Freitext - Hintergrundfarbe
Cells(5, spalte).Font.Color = 16777215 'Filter - Schrift
Cells(5, spalte).Interior.Color = 11272192 'Filter - Hintergrundfarbe
End If
Next spalte
End If
End With
End If
'Zeile3 auslesen und in Filter schreiben
For i = 1 To 27
Sheets("Filter").Cells(3, i).Value = Sheets("Masterliste_U7").Cells(3, i).Value
Next i
ActiveSheet.Range(rngMarkiert.Address).Select
err_exit:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub