VBA Code sehr langsam - Optimierung möglich?

Public Function Suche(Matnr As Long) On Error Resume Next Dim start As Long Dim ende As Long Dim antwortzeile As Long Dim Lagerort As String Lagerort = "Fach123" ' S U C H E start = Sheets("Gesamtliste").Range("F1:F40000").find(Matnr).Row ende = Sheets("Gesamtliste").Range("F1:F40000").find(Matnr, SearchDirection:=xlPrevious).Row antwortzeile = Sheets("Gesamtliste").Range("C" & start & ":C" & ende).find(Lagerort).Row Suche = antwortzeile End Function

Sub test() On Error Resume Next With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With Dim nummer As Long Dim y As Integer y = 1 For i = 10 To 100 If Sheets("Extract").Cells(i, 5).Value "" Then If Sheets("Materialliste").Cells(i, 11).Value = "X" Then nummer = Suche(Sheets("Materialliste").Cells(i, 5).Value) Sheets("Materialliste").Cells(y, 12).Value = nummer y = y + 1 End If End If Next With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hi Maddin,
so was ohne Beispieldatei ist immer eine große Raterei...
Wa mich stutzig macht, ist das y; außerdem kommen mir die 2 Blätter Extract und Materialliste irgendwie doppelt gemoppelt vor.
Aber sei's drum.
Bei Performace-Problemen bietet es sich an, die Funktionalität ohne Auslagerung von Code in Subs oder Functions zu erledigen.
Damit sind unnütze Zuweisungen wie das turnusmäßig abgearbeitete Lagerort = "Fach123" nur *einmal* zu erledigen, außerdem ist der Zwischenschritt bei

antwortzeile = Sheets("Gesamtliste").Range("C" & start & ":C" & ende).find(Lagerort).Row
Suche = antwortzeile

relativ sinnlos: Suche = Sheets.... tut es auch.
Ich denke, die mittlere Suche kann man einsparen: wenn Du von start aus in C suchst und beim ersten Treffer überprüfst, ob die Materialnr. in F noch identisch ist, bist Du grad so weit.
Versuch's mal damit (ist natürlich mangels Datei ungetestet!):

Option Explicit
Sub test2()
Const Lagerort = "Fach123"
Dim nummer As Long
Dim y As Long, i As Long, k As Long        ' i war nicht deklariert
Dim start As Long, bis As Long, zeile1 As Long
Dim c As Range
Dim t#(0 To 3)
' On Error Resume Next             ' naja
On Error GoTo errExit
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
y = 1
bis = Sheets("Gesamtliste").Range("F" & Rows.Count).End(xlUp).Row
For i = 10 To 100
t(0) = Timer
If Sheets("Extract").Cells(i, 5).Value  "" Then
If Sheets("Materialliste").Cells(i, 11).Value = "X" Then
nummer = Sheets("Materialliste").Cells(i, 5).Value
t(1) = Timer
Set c = Sheets("Gesamtliste").Range("F1:F" & bis).Find(nummer)
If Not c Is Nothing Then
zeile1 = c.Row
t(2) = Timer
Set c = Sheets("Gesamtliste").Range("C" & zeile1 & ":F" & bis).Find(Lagerort)
If Not c Is Nothing Then
If c.Offset(0, 3).Value = nummer Then
Sheets("Materialliste").Cells(y, 12).Value = c.Row
t(3) = Timer
For k = 0 To 3
' Bitte Direktfenster einschalten!
Debug.Print "t" & k & ": " & t(k)
Next
Else
Sheets("Materialliste").Cells(y, 12).Value = "n.v."
End If
End If
Else
Sheets("Materialliste").Cells(y, 12).Value = "n.v."
End If
End If
y = y + 1
End If
Next
errExit:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Anhand des Timers im Direktfenster kannste sehen, was am längsten dauert.
Schöne Grüße,
Michael

Beliebteste Forumthreads (12 Monate)

VBA Code sehr langsam - Optimierung möglich?

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

286 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Code sehr langsam - Optimierung möglich?

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

286 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread