Excel vba braucht sehr lange
31.01.2014 08:49:29
matthias
kann mir jemand erklären warum der Code ca. 2 minuten zum Ausführen benötigt?
Ich vermute das es mit den Variablen zusammenhängt, denn eine andere Kopiermethode oder ein Fehler direkt am Anfang der Schleife hat die Zeit nicht verkürzt.
Private Sub CommandButton1_Click()
'Datenbank kopieren (Abas Zusatzdatenbank --> Filterbearbeitung)
Worksheets("Abas Zusatzdatenbank").Columns("A:J").Copy Destination:=Worksheets(" _
Filterbearbeitung").Range("A1")
'Löschen der Zeilen, welche das Filterkriterium nicht erfüllen
Dim artikelnummer As String
Dim kanbanlagerort As String
Dim füllgröße As String
Dim behälterart As String
Dim liefer As String
Dim kanbanart As String
Dim sparte As String
Dim lieferant As String
artikelnummer = Sheets("Lagerplatz Verwaltung").Cells(27, 14).Value
kanbanlagerort = Sheets("Lagerplatz Verwaltung").Cells(27, 15).Value
füllgröße = Sheets("Lagerplatz Verwaltung").Cells(27, 17).Value
behälterart = Sheets("Lagerplatz Verwaltung").Cells(27, 18).Value
liefer = Sheets("Lagerplatz Verwaltung").Cells(27, 19).Value
kanbanart = Sheets("Lagerplatz Verwaltung").Cells(27, 20).Value
sparte = Sheets("Lagerplatz Verwaltung").Cells(27, 21).Value
lieferant = Sheets("Lagerplatz Verwaltung").Cells(27, 22).Value
'Löschen der Zeilen, welche das Filterkriterium nicht erfüllen
Dim max As Long
max = Sheets("Filterbearbeitung").Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = max To 1 Step -1
If Not IsError(Sheets("Filterbearbeitung").Cells(i, 2).Value) Then
If Sheets("Filterbearbeitung").Cells(i, 2).Value artikelnummer And Not artikelnummer = "" _
Then
Sheets("Filterbearbeitung").Rows(i).Delete
GoTo Ende
End If
End If
If Not IsError(Sheets("Filterbearbeitung").Cells(i, 3).Value) Then
If Sheets("Filterbearbeitung").Cells(i, 3).Value kanbanlagerort And Not kanbanlagerort = _
"" Then
Sheets("Filterbearbeitung").Rows(i).Delete
GoTo Ende
End If
End If
If Not IsError(Sheets("Filterbearbeitung").Cells(i, 5).Value) Then
If Sheets("Filterbearbeitung").Cells(i, 5).Value füllgröße And Not füllgröße = "" Then
Sheets("Filterbearbeitung").Rows(i).Delete
GoTo Ende
End If
End If
If Not IsError(Sheets("Filterbearbeitung").Cells(i, 6).Value) Then
If Sheets("Filterbearbeitung").Cells(i, 6).Value behälterart And Not behälterart = "" _
Then
Sheets("Filterbearbeitung").Rows(i).Delete
GoTo Ende
End If
End If
If Not IsError(Sheets("Filterbearbeitung").Cells(i, 7).Value) Then
If Sheets("Filterbearbeitung").Cells(i, 7).Value liefer And Not liefergeorg = "" Then
Sheets("Filterbearbeitung").Rows(i).Delete
GoTo Ende
End If
End If
If Not IsError(Sheets("Filterbearbeitung").Cells(i, 8).Value) Then
If Sheets("Filterbearbeitung").Cells(i, 8).Value kanbanart And Not kanbanart = "" Then
Sheets("Filterbearbeitung").Rows(i).Delete
GoTo Ende
End If
End If
If Not IsError(Sheets("Filterbearbeitung").Cells(i, 9).Value) Then
If Sheets("Filterbearbeitung").Cells(i, 9).Value sparte And Not sparte = "" Then
Sheets("Filterbearbeitung").Rows(i).Delete
GoTo Ende
End If
End If
If Not IsError(Sheets("Filterbearbeitung").Cells(i, 10).Value) Then
If Sheets("Filterbearbeitung").Cells(i, 10).Value lieferant And Not lieferant = "" Then
Sheets("Filterbearbeitung").Rows(i).Delete
GoTo Ende
End If
End If
Ende:
Next i
End Sub