Code läuft extrem langsam
24.10.2017 13:37:26
Tobias
Ich habe auf der Arbeit seit einiger Zeit die Aufgabe, gewisse Dinge mit Excel zu programmieren und mich deshalb selber eingearbeitet. Nun stehe ich allerdings vor einem Problem, bei dem ich selber nicht wirklich weiterkomme.
Aus einer Listbox werden verschiedene Gesellschaften ausgewählt. Sobald auf "ok" geklickt wird, soll in Tabelle 1 in einer Spalte nach den in der Listbox ausgewählten Werten gesucht werden. Sofern der Wert in der Spalte mit dem in der Listbox ausgewählten Wert identisch ist, sollen gewisse Werte aus der Zeile ausgelesen und in Tabelle 2 geschrieben werden.
Da Tabelle 1 bis zu 3000 Zeilen hat, läuft die Schleife ewig. Daher meine Frage: Habt ihr Tipps, wie ich den Code beschleunigen kann? Gerne auch komplett andere Ansätze, die meinen Code ganz über den Haufen werfen.
Private Sub cmd_OK_Click()
Dim i As Integer
Dim k As Integer
Dim R As Integer
Dim Z As Integer
Dim ZeileMax As Integer
Dim ZeileMaxTab1 As Integer
Application.ScreenUpdating = False
With Tabelle2
'Bereich der ausgewählten Daten wird zunächst geleert
ZeileMax = .Cells(21, 2).End(xlDown).Row
.Range("B21:E" & ZeileMax).Clear
End With
'Daten der ausgewählten Einzelgesellschaften werden übernommen
k = 21
R = 1
ZeileMaxTab1 = Tabelle1.Cells(2, 3).End(xlDown).Row
For i = 0 To Me.List_EG.ListCount - 1
If Me.List_EG.Selected(i) = True Then
For Z = 2 To ZeileMaxTab1
If Tabelle1.Cells(Z, 3).Value = Me.List_EG.Column(0, i) Then
Tabelle2.Cells(k, 3).Value = Tabelle1.Cells(Z, 4).Value
Tabelle2.Cells(k, 4).Value = Tabelle1.Cells(Z, 5).Value
Tabelle2.Cells(k, 5).Value = Tabelle1.Cells(Z, 3).Value
Tabelle2.Cells(k, 2).Value = R
R = R + 1
k = k + 1
End If
Next Z
End If
Next i
Application.ScreenUpdating = True
'Dialogfeld wird geschlossen
Unload Me
End Sub