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