heute beschäftigt mich folgendes Problem :
In einem Tabellenblatt befindet sich eine recht lange Daten-Liste (20 Spalten, ca. 12.000 Zeilen) und 3 CommandButtons :
- -
Hinter diesen 3 Commandbuttons verbergen sich je ein Makro :
- "Filtern nach Datum" : Zeigt ein UserForm an, in dem ein START- und ein ENDE-Datum eingegeben wird und die Liste in Spalte Q (=Spalte 17) nach diesem Datum gefiltert wird (per Autofilter).
- "Autofilter aus" : Deaktiviert die Autofilter und zeigt wieder die komplette Liste an
- "Datenmaske" : Zeigt ein UserForm an, in dem die Daten editiert werden können (ähnlich des Befehls "Daten - Maske", jedoch mit ein paar Besonderheiten, daher selbst programmiert).
In diesem UserForm befindet sich u.a. ein Commandbutton "Letzten Datensatz kopieren", mit dem der letzte Datensatz der (sortierten) Liste im UF angezeigt wird, und nach Bestätigung als neuer Datensatz in der Liste hinzugefügt wird.
Jetzt das Problem : Wenn die Mappe geöffnet wurde, funktioniert das Kopieren des letzten Datensatzes sehr schnell (gemessen : deutlich unter 1 Sek.). Diesen vorgang kann man beliebig oft wiederholen, ohne spürbaren Geschwindigkeitsunterschied.
Wenn nun aber die Liste einmalig über den Autofilter gefiltert wurde (egal ob manuell oder über das MAkro !) und dieser wieder deaktiviert wurde, dauert das Kopieren der Datensätze nun deutlich länger : ca. 1-2 Sekunden !
Wie kann das passieren ? Bzw. : Wie kann man das verhindern ? Gibt es eine Art "Cache" des Autofilters, der die Geschwindigkeit reduziert (Ähnlich PivotCache oder TableQueries) ? Wenn ja: Wie kann man diesen per VBA löschen ?
Ich habe bereits die Alternative per Spezialfilter (bzw. VBA: "AdvancedFilter") probiert, damit dauert es noch länger. Auch das Speichern der Mappe und das damit verbundene Löschen der "Rückgängig-Schritte" brachte keinen Erfolg ! ebensowenig half das Deaktivieren des Sortiervorgangs im Makro :-(
Hat jemand noch eine andere Idee, wie man NACH dem Filtern die gleiche Geschwindigkeit erreichen kann wie VOR dem Filtern ?
Hier ein paar Code-Auszüge :
Mit diesem Makro (im UF "Filtern") wird die Liste nach Datum gefiltert :
Private Sub CommandButton1_Click()
'Das Makro zum Filtern der Liste nach Datum_VON und Datum_BIS :
Dim lz
Dim shBew As Worksheet
Set shBewetterung = Sheets("Bew")
shBewetterung.AutoFilterMode = False
lz = shBewetterung.Cells(Rows.Count, "A").End(xlUp).Row
shBewetterung.Range("A3:R" & CStr(lz)).AutoFilter Field:=17, _
Criteria1:=">=" & CDbl(CDate(TextBox1)), Operator:=xlAnd, _
Criteria2:="<=" & CDbl(CDate(TextBox2))
'
Range("A4").CurrentRegion.Sort Key1:=Range("J4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
UserForm2.Hide
ActiveWindow.View = xlPageBreakPreview
End Sub
Mit diesem Makro wird der Autofilter (bzw. auch Spezialfilter) deaktiviert :
Public Sub filter_aus()
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
ElseIf ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
If Err.Number = 1004 Then Exit Sub
letztezeile = Range("A4").End(xlDown).Row
Range("A4:P" & letztezeile).Sort Key1:=Range("E4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveWindow.View = xlNormalView
[A4].End(xlDown).Select 'Letzte Zeile markieren
End Sub
Mit diesem Makroteil wird der letzte Datensaz in das UF "Datenmaske" eingelesen :
Private Sub cmbkopieren_Click()
'Daten aus der Liste in die Datenmaske kopieren :
Application.ScreenUpdating = False
letztezeile = Range("A4").End(xlDown).Row
UserForm1.cmbname = Range("A" & letztezeile).Value
UserForm1.Txtauftragsnummer = Range("B" & letztezeile).Value
UserForm1.Txtabteilung = Range("C" & letztezeile).Value
'etc. : Noch weitere Felder im gleichen Stil
Application.ScreenUpdating = True
End Sub
Mit diesem Makroteil wird der geänderte Datensatz als neue Datenzeile wieder in die Liste zurückgeschrieben.
Hier tritt das Problem auf, dass das nach dem Filtern recht lange dauert :
Private Sub Einfuegen()
Dim letztezeile
'Status des Berechnungsmodus speichern und auf "MANUELL" setzen :
Dim calcSave
calcSave = Application.Calculation
Application.Calculation = xlCalculationManual 'Berechnung auf MANUELL !
Sheets("Bewetterungen I99").Select
'Erst mal gesamte Zeile kopieren :
Range("A" & letztezeile & ":R" & letztezeile).Copy Range("A" & letztezeile + 1)
'Änderungen aus dem UF in die Zeile kopieren :
On Error Resume Next
Range("A" & letztezeile + 1).Value = UserForm1.cmbname
Range("B" & letztezeile + 1).Value = UserForm1.Txtauftragsnummer
Range("C" & letztezeile + 1).Value = UserForm1.Txtabteilung
'etc. : weitere Felder im gleichen Stil in die Liste zurückschreiben....
Unload UserForm1 'die "Datenmaske" entladen
Range("A4").End(xlDown).Select
Application.Calculation = calcSave 'Berechnung wieder zurückstellen
End Sub
Vielen Dank für eure Unterstützung,
Gruß NoNet