Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1732to1736
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Performance beim löschen verbessern?

Performance beim löschen verbessern?
14.01.2020 20:00:27
Andre
Hallo,
ich habe mit Hilfe verschiedenster Codes eine Lagerverwaltung erstellt.
U.a. rufe ich Daten in eine Listbox auf, die dann per Command-Button aus der Listbox in ein Tabellenblatt geschrieben werden. Im Anschluß wird ein Abgleich einer Palettennummer gemacht und die dazugehörigen Zeilen im Tabellenblatt gelöscht. Dieses löschen dauert, da es ca. 6.000 Zeilen sind, schon etwas länger.
Daher nun meine Frage, ob jemand mir sagen kann, wie ich die Performance verbessern kann und das Löschen schneller geht?
Hier mein Code:
Private Sub CommandButton3_Click()
' in Transit kopieren
Dim last As Integer
Worksheets("BESTAND").Activate
last = Tabelle9.Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 0 To ListBox2.ListCount - 1
Tabelle9.Cells(last, 1) = ListBox2.List(i, 0)
Tabelle9.Cells(last, 2) = ListBox2.List(i, 1)
Tabelle9.Cells(last, 3) = ListBox2.List(i, 2)
Tabelle9.Cells(last, 4) = ListBox2.List(i, 3)
Tabelle9.Cells(last, 5) = TextBox_Shipment
Tabelle9.Cells(last, 6) = ListBox2.List(i, 4)
Tabelle9.Cells(last, 7) = ListBox2.List(i, 5)
Tabelle9.Cells(last, 8) = ListBox2.List(i, 6)
If IsNumeric(ListBox2.List(i, 6)) Then
Tabelle9.Cells(last, 8) = CDbl(ListBox2.List(i, 6))
End If
Tabelle9.Cells(last, 9) = ListBox2.List(i, 7)
Tabelle9.Cells(last, 10) = ListBox2.List(i, 8)
Tabelle9.Cells(last, 11) = ListBox2.List(i, 9)
last = last + 1
Next
Dim intz As Integer, durchsuchen, finden As Range
Dim x&
With ListBox2
For x = .ListCount - 1 To 0 Step -1 'die Schleife unbedingt rückwärts laufen lassen!
If .Selected(x) = True Then
Set durchsuchen = Sheets("BESTAND").Range("A2:A" & Sheets("BESTAND").Range(" _
A65536").End(xlUp).Row)
For Each finden In durchsuchen
If finden.Text = .List(x, 0) Then     'Textvergleich der Tabelle mit Listbox  _
Zeile(x) aus Spalte1!
intz = finden.Row                  'Zeile ermitteln
Cells(intz, 11).EntireRow.Delete    'Zeile in Tabelle löschen
Exit For
End If
Next finden
'erst jetzt den Eintrag in Listbox löschen!
.RemoveItem (x)
End If
Next
ListBox1.Clear
TextBox_Artikel.Value = ""
TextBox_Shipment.Value = ""
ComboBox_Spediteur.Value = ""
TextBox_Shipment.SetFocus
End With
End Sub
Danke für Tips!
Gruß
Andre

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Performance beim löschen verbessern?
14.01.2020 20:32:13
Hajo_Zi
Hallo Andre,
Lösche die Zeilen nicht einzeln. Folgendes Prinzip.
Option Explicit
Sub DoppelteWerte_löschen()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim RaZelle As Range
Dim IntRow As Long
Dim Start As Long
IntRow = IIf(IsEmpty(Cells(Rows.Count, 1)), _
Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
For Start = IntRow To 1 Step -1
If Not IsEmpty(Cells(Start, 1)) Then
If Application.CountIf(Range("A1:A" & Start), Cells(Start, 1)) > 1 Then
If RaZelle Is Nothing Then
Set RaZelle = Cells(Start, 1)
Else
Set RaZelle = Union(RaZelle, Cells(Start, 1))
End If
End If
End If
Next
If Not RaZelle Is Nothing Then RaZelle.ClearContents
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Anzeige
AW: Performance beim löschen verbessern?
15.01.2020 08:53:46
Luschi
Hallo Andre,
hier mal mein Versuch:

Private Sub CommandButton3_Click()
' in Transit kopieren
Dim last&, i As Integer
Call GetMoreSpeed(True)
ThisWorkbook.Worksheets("BESTAND").Activate
With Tabelle9
last = Tabelle9.Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 0 To ListBox2.ListCount - 1
.Cells(last, 1).Value = Me.ListBox2.List(i, 0)
.Cells(last, 2).Value = Me.ListBox2.List(i, 1)
.Cells(last, 3).Value = Me.ListBox2.List(i, 2)
.Cells(last, 4).Value = Me.ListBox2.List(i, 3)
.Cells(last, 5).Value = Me.TextBox_Shipment
.Cells(last, 6).Value = Me.ListBox2.List(i, 4)
.Cells(last, 7).Value = Me.ListBox2.List(i, 5)
''.Cells(last, 8).Value = Me.ListBox2.List(i, 6)
If IsNumeric(Me.ListBox2.List(i, 6).Value) Then
.Cells(last, 8).Value = CDbl(Me.ListBox2.List(i, 6))
End If
.Cells(last, 9).Value = Me.ListBox2.List(i, 7)
.Cells(last, 10).Value = Me.ListBox2.List(i, 8)
.Cells(last, 11).Value = Me.ListBox2.List(i, 9)
last = last + 1
Next
Call GetMoreSpeed(False)
.UsedRange.Calculate
End With
Dim durchsuchen As Range, finden As Range, xRg As Range, _
x&, fAdr As String
Call GetMoreSpeed(True)
With Me.ListBox2
For x = .ListCount - 1 To 0 Step -1 'die Schleife unbedingt rückwärts laufen lassen!
If .Selected(x) Then
With Sheets("BESTAND")
Set durchsuchen = .Range(.Cells(2, "A"), Cells(.Rows.Count, "A").End(xlUp).Row)
End With
'Textvergleich der Tabelle mit Listbox Zeile(x) aus Spalte1!
Set finden = durchsuchen.Find(.List(x, 0).Value, , xlValues, _
xlWhole, xlByColumns, xlNext, False, False, False)
If Not (finden Is Nothing) Then
'damit sich die anschl. Do-Schleife nicht im Kreise dreht
'1- Fundstellenadresse merken
fAdr = finden.Address(0, 0)
Do
'alle Fundstellen merken
If xRg Is Nothing Then
Set xRg = finden
Else
Set xRg = Union(finden, xRg)
End If
Set finden = durchsuchen.FindNext(finden)
'finden.Address(0, 0)  fAdr ist die Ausstiegsklauses aus der Schleife
Loop While finden.Address(0, 0)  fAdr
'vom gesammelten Bereich Zeilen löschen
xRg.EntireRow.Delete
'erst jetzt den Eintrag in Listbox löschen!
.RemoveItem (x)
End If
Set xRg = Nothing: Set finden = Nothing: Set durchsuchen = Nothing
Next x
.Clear
End With
With Me
.TextBox_Artikel.Value = ""
.TextBox_Shipment.Value = ""
.ComboBox_Spediteur.Value = ""
.TextBox_Shipment.SetFocus
End With
Call GetMoreSpeed(False)
ThisWorkbook.Sheets("BESTAND").UsedRange.Calculate
End Sub
'in einem Standard-Modul
Sub GetMoreSpeed(bYesNo As Boolean)
With Application
.ScreenUpdating = Not (bYesNo)
.EnableEvents = Not (bYesNo)
.Calculation = IIf(bYesNo, xlCalculationManual, _
xlCalculationAutomatic)
.Cursor = IIf(bYesNo, 2, -4143)
End With
End Sub
Sollte die Find-Funktion (Set finden = durchsuchen.Find(...)) nichts finden,
dann ist die Suchspalte stark formatiert und man muß an den Übergabeparametern noch was umstellen.
Gruß von Luschi
aus klein-Paris
Anzeige
AW: Performance beim löschen verbessern?
15.01.2020 19:28:05
Andre
Hallo Daniel,
'erst jetzt den Eintrag in Listbox löschen!
.RemoveItem (x)
End If
Set xRg = Nothing: Set finden = Nothing: Set durchsuchen = Nothing
Next x
.Clear
End With
Wenn ich den Code einfüge, bekomme ich beim "Next x" eine Fehlermeldung "Next ohne For"
AW: Performance beim löschen verbessern?
15.01.2020 19:40:54
Daniel
Hi
check mal alle deine Kontrollstrukturen wie
For-Next
IF - END IF
WITH - END WITH
usw auf Vollständigkeit und richtige Platzierung
diese Strukturen müssen immer ineinander geschachtelt werden wie Matroschkas und dürfen sich nicht überlappen.
wenn du beispielsweise sowas schreibst und das End IF vergisst:
For …
IF … Then
Next
dann gehört das NEXT noch in den IF-Block und das dazugehörige FOR müsste NACH dem IF..THEN und vor Next auftauchen.
das Next wird erst nach dem END IF erwartet.
das fehlende FOR ist aber der erste Fehler, auf den der Interpreter stößt, wenn er den Code von oben nach unten durchgeht, daher die etwas verwirrende Fehlermeldung.
Gruß Daniel
Anzeige
Außerdem ist das .RemoveItem bei meiner
15.01.2020 19:55:32
Daniel
Methode nicht notwendig, das kannst du einfach löschen.
Gruß Daniel
AW: Performance beim löschen verbessern?
15.01.2020 10:27:09
Daniel
Hi
die Performance beim Löschen von Zeilen lässt sich auf zwei Wegen dramatisch verbessern:
1. man sortiert die Tabelle vor dem löschen so, dass alle zu löschenden Zeilen einen lückenlos zusammenhängenden Zellblock bilden und löscht dann diesen Zellblock in einem Schritt.
Excel braucht für Range("1:1000").Delete genauso lange wie für Range("1:1").Delete.
2. man kennzeichnet die zu löschenden Zeilen per Formel in einer Hilfsspalte so, dass alle zu löschenden Zeilen den gleichen Wert haben, der auch in der Überschriftenzeile der Hilfsspalte steht und alle Zeilen die stehen bleiben müssen mit einem individuellen Wert, beispielsweise der Zeilennummer.
dann löscht man die Zeilen mit Hilfe der Funktion DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN und der Hilfsspalte als Kriterium
Hintergrund des ganze ist folgendes Problem:
das Löschen von vielen Einzelzeilen ist deswegen so langsam, weil Excel bei jedem Löschen einer Zeile prüfen muss, ob irgendwo in den geöffneten Exceldateien eine Formel vorhanden ist, welche einen Zellbezug auf die gelöschte Zeilen hat und deren Zellbezug dann angepasst werden muss.
(hast du =Summe(A1:A10) und löschst die Zeile 8, wird daraus =Summe(A1:A9))
Variante 1 ist deswegen so schnell, weil diese Aktion beim Löschen eines lückenlosen Zellblocks für den gesamten Block in einem Schritt ausgeführt werden kann und nicht für jede Zeile einzeln.
Variante 2 ist deswegen so schnell, weil beim Duplikate-entfernen diese Aktion nicht ausgeführt wird und keine Anpassung der Formeln erfolgt.
Gruß Daniel
Anzeige
AW: Performance beim löschen verbessern?
15.01.2020 11:04:30
Luschi
Hallo Daniel,
jetzt mußt Du dem Fragesteller nur noch erläutern, wie Deine theoretischen Betrachtungen in die Praxis umgesetzt werden - und nicht gesamte Datenblöcke ins Nirvana geschickt werden.
Gruß von Luschi
aus klein-Paris
AW: Performance beim löschen verbessern?
15.01.2020 11:09:33
Daniel
gerne, wenn er fragt.
vielleicht reichen bei Excel-gut / VBA-bescheiden diese Anregungen ja aus.
das Einfügen von Formeln, Sortieren und Duplikate entfernen lässt sich ja auch recht gut mit dem Recorder aufzeichen.
Gruß Daniel
AW: Performance beim löschen verbessern?
15.01.2020 11:28:55
Daniel
das Auffinden und Kennzeichen der zu löschenden Zeilen kann man natürlich auch noch optimieren:
dim arr
dim txt as string
dim z as  Long
txt = "|"
With Listbox2
for z = 0 to .listcount - 1)
if .selected(z) Then txt = txt & .List(z, 0) & "|"
next
end with
with Sheets("BESTAND").Usedrange
arr = .columns(1).value
for z = 2 to ubound(arr)
if Instr(txt, "|" & arr(z, 1) & "|") > 0 then
arr(z, 0) = 0
else
arr(z, 0) = z
end if
next
arr(1, 1) = 0
with .columns(.columns.count + 1)
.value = arr
.EntireRow.RemoveDuplicates .column, xlno
.ClearContents
end with
end with

Gruß Daniel
Anzeige
AW: Performance beim löschen verbessern?
15.01.2020 19:09:05
Andre
Hallo Hajo, Daniel und Luschi,
erst einmal Danke für Eure Antworten, von denen ich ehrlich gesagt, keinen großen Durchblick habe.
Da meine Kenntnisse (sehr) bescheiden sind, hilft es mir am meisten, wenn die Codezeilen angepasst und kurz erläutert werden könnten bzw. wenn wie oben eine Code von Euch (über die ich sehr dankbar bin) erstellt wird, mir noch kurz gesagt wird, an welcher Stelle er einzufügen ist.
@Daniel: Zu Deiner Anmerkung "Hintergrund des ganze ist folgendes Problem:
das Löschen von vielen Einzelzeilen ist deswegen so langsam, weil Excel bei jedem Löschen einer Zeile prüfen muss, ob irgendwo in den geöffneten Exceldateien eine Formel vorhanden ist, welche einen Zellbezug auf die gelöschte Zeilen hat und deren Zellbezug dann angepasst werden muss.
(hast du =Summe(A1:A10) und löschst die Zeile 8, wird daraus =Summe(A1:A9))
Ich probiere jetzt die Codes mal aus und melde mich ggf. noch einmal" habe ich mal eine Frage:
Wenn ich im Tabelleblatt die Suchfunktion nutze kann man unter den Optionen ja bei "suchen in" wählen zwischen Formeln, werten und Kommentaren. Ist die Einstellung auf Formel eingestellt, geht das Suchen sehr schnell. Ist das eventuell auch eine Variante, die man in meinem Code anpassen kann?
Ich würde jetzt mal Deinen Code probieren und mich noch einmal melden.
Danke zunächst
Andre
Anzeige
AW: Performance beim löschen verbessern?
15.01.2020 20:12:12
Daniel
probiers aus.
hängt immer ein bisschen davon ab, wieviele Zeilen gelöscht werden müssen.
meiner Erfahrung nach ist das .FIND in etwa so schnell, wie wenn man sich die Daten in ein Array lädt und dann mit einer Schleife durch dieses Array läuft.
der Unterschied kommt zum Tragen, wenn mehrere Werte gesucht werden müssen.
bei der selbstprogrammierten Array-Variante hat man den Vorteil dass man, wenn immer der selbe Bereich durchsucht werden muss, man diesen nur einmal ins Array laden muss.
beim .Find ist jedes Suchen unabhängig von der zuvor ausgeführten Suche, dh VBA muss sich jedesmal die Daten wieder aus der Tabelle in den Zwischenspeicher laden, um die Werte zu durchsuchen.
Gruß Daniel
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige