Performance - Problem | HERBERS Excel Forum

Hallo liebe Excel Freunde,
in den letzten Jahren ist meine LOP (list of open points) immer mehr gewachsen (auch Dank euch!! DANKE) und die Kollegen hätten das nun auch gerne.
Jetzt bin ich dabei das Teil mal etwas benutzerfreundlicher zu gestalten.
Die wichtigste Funktion in der LOP ist die Suchfunktion. Wenn in Zeile 7 ein Begriff getippt wird werfe ich einen Filter an, der die Spalte nach dem Begriff filtert und den Begriff in den Zellen einfärbt.
Wird der Begriff aus Zeile 7 gelöscht, wird die Farbe zurückgesetzt und der Filter auch.
Die "echte" Liste hat ca. 400 Zeilen - die kann ich euch leider nicht hochladen.
Habe kurz aus der Liste ein 10-zeiliges Beispiel gemacht:
https://www.herber.de/bbs/user/109436.xlsm
Bitte einfach mal in die Zelle G7 "rost" reintippen, dann seht ihr gleich was passiert.
zum Performance Problem:
Beim Rücksetzen der Farbe, also nach dem Rauslöschen des Begriffs aus Zeile 7, dauert das bei meinen 400 Zeilen mittlerweile ca. 10 Sekunden. Da springt manchmal schon das "Keine Rückmeldung" an...
Im 10-zeiligen Beispiel geht es ruckzuck.
Ich hab in der Datei in der Tabelle "LOP" beim Change-Ereignis den Aufruf markiert bzw. in Modul 1 die beiden betreffenden Subs (SetFarbe, ResetFarbe) ganz rauf kopiert, damit alles leichter zu finden ist.
Habt ihr eine Idee wie ich den 'Sub ResetFarbe' schlanker gestalten könnte?
Hier der 'Sub' allein, falls die ganze Datei gar nicht notwendig ist:
Vielen Dank vorab!


Sub ResetFarbe()
Application.ScreenUpdating = False
Application.EnableEvents = False
Call Parameter_update
For i = 1 To Columns(spalte_letzte).Column
With Range(Cells(zeile_filter, i), Cells(letztezeile_beschr, i)).Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
If i >= Columns(spalte_beschreibung).Column Then
.Bold = False
End If
End With
Next i
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Sub Parameter_update()
'Parameter aus Tabellenblatt "Parameter" laden. User kann Spalten hinzufügen und muss nur die   _
_
Parameter im TB "Parameter" anpasssen
zeile_filter = Sheets("Parameter").Range("A2")
startzeile_punkte = Sheets("Parameter").Range("A3")
spalte_datum = Sheets("Parameter").Range("A6")
spalte_termin = Sheets("Parameter").Range("A4")
spalte_beschreibung = Sheets("Parameter").Range("A5")
spalte_letzte = Sheets("Parameter").Range("A7")
letztezeile_beschr = Sheets("LOP").Cells(Rows.Count, spalte_beschreibung).End(xlUp).row
letztezeile_a = Range("A8").CurrentRegion.Cells(Range("A8").CurrentRegion.Cells.Count).row
'Sheets("LOP").Cells(Rows.Count, 1).End(xlUp).row
spalte_ist = Sheets("Parameter").Range("A8")
spalte_verant = Sheets("Parameter").Range("A9")
spalte_zoom = Sheets("Parameter").Range("A10")
zeile_ueber = Sheets("Parameter").Range("A11")
spalte_prio = Sheets("Parameter").Range("A12")
spalte_projekt = Sheets("Parameter").Range("A13")
End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fehler Application.ScreenUpdating = False If Worksheets("T1").Range("a4") = 1 Then ThisWorkbook.Save End If Application.EnableEvents = False col = Target.Column row = Target.row If Target.Column >= Columns(spalte_termin).Column Or Target.row > letztezeile_a Then Call aktualisieren End If If row "" Then ActiveSheet.Range("A" & zeile_filter & ":" & spalte_letzte & "500").AutoFilter _ Field:=col, Criteria1:="*" & Cells(zeile_filter, col) & "*", _ Criteria2:=Cells(zeile_filter, col), Operator:=xlOr Call SetFarbe Else ActiveSheet.Range("A" & zeile_filter & ":" & spalte_letzte & "500").AutoFilter _ Field:=col Call ResetFarbe End If Application.Calculation = xlCalculationAutomatic End If '=========================================================================================== _ Application.ScreenUpdating = True Application.EnableEvents = True Exit Sub Fehler: Call Parameter_update Resume End Sub

Sub ResetFarbe() Call Parameter_update With Range(Cells(zeile_filter, 1), Cells(letztezeile_beschr, spalte_letzte)).Font .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 End With With Range(Cells(zeile_filter, spalte_beschreibung), _ Cells(letztezeile_beschr, spalte_letzte)).Font .Bold = False End With End Sub

Beliebteste Forumthreads (12 Monate)

Performance - Problem

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread