Makro definitiv zu langsam
12.01.2018 10:45:18
Burak
also jetzt geht es um Performance, da das Makro für seine Aufgabe bei einem Testbeispiel mit 3 Werten etwa 30 sekunden braucht, das ganze aber eher hunderte bis tausende Einträge haben wird.
Sub zusammenfuegen()
'Deklaration der Variablen
Dim schrott As Byte
Dim Zeilenzahlschrott As Long
Dim Zeilenzahlaoi As Long
Dim Zeilenzahllog As Long
schrott = 0
'Blatt leeren
Worksheets("Gesamtliste").Cells.Clear
'Zeilen des LogImports zählen
With Worksheets("LogImport")
Zeilenzahllog = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
'LogImport-Schleife
For i = 2 To Zeilenzahllog
'Zeilen der Schrottliste zählen
With Worksheets("Schrottliste")
Zeilenzahlschrott = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
'Überprüfung ob verschrottet
For j = 2 To Zeilenzahlschrott
If Worksheets("Logimport").Range("B" & i).Value = Worksheets("Schrottliste").Range("A" & _
j).Value Then
schrott = 1
End If
Next j
'Wenn nicht verschrottet
If schrott = 0 Then
'Linien-Schleife
For l = 1 To 5
'Zeilenzählen
With Worksheets("R" & l)
Zeilenzahlaoi = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
'Logimport-AOI-Vergleich-Schleife
For k = 2 To Zeilenzahlaoi
'Bedingung Barcode identisch
If Worksheets("Logimport").Range("B" & i).Value = Worksheets("R" & l).Range("B" & k). _
Value Then
'Bedingung Bauteilname identisch
If Worksheets("Logimport").Range("C" & i).Value = Worksheets("R" & l).Range("G" & k) _
.Value Then
'Bedingung PIN identisch
If Worksheets("Logimport").Range("D" & i).Value = Worksheets("R" & l).Range("J" & _
k).Value Then
'Bedingung Analyse-Typ identisch
If Worksheets("Logimport").Range("F" & i).Value = Worksheets("R" & l).Range("K" _
& k).Value Then
'Werteübernahme der übereinstimmenden Zeilen
With Worksheets("Gesamtliste")
.Range("A" & i).Value = Worksheets("R" & l).Range("A" & k).Value
.Range("B" & i).Value = Worksheets("R" & l).Range("B" & k).Value
.Range("C" & i).Value = Worksheets("R" & l).Range("C" & k).Value
.Range("D" & i).Value = Worksheets("R" & l).Range("D" & k).Value
.Range("E" & i).Value = Worksheets("R" & l).Range("E" & k).Value
.Range("F" & i).Value = Worksheets("R" & l).Range("F" & k).Value
.Range("G" & i).Value = Worksheets("R" & l).Range("G" & k).Value
.Range("H" & i).Value = Worksheets("R" & l).Range("H" & k).Value
.Range("I" & i).Value = Worksheets("R" & l).Range("I" & k).Value
.Range("J" & i).Value = Worksheets("R" & l).Range("J" & k).Value
.Range("K" & i).Value = Worksheets("R" & l).Range("K" & k).Value
.Range("L" & i).Value = Worksheets("R" & l).Range("L" & k).Value
.Range("M" & i).Value = Worksheets("Logimport").Range("G" & i).Value
.Range("N" & i).Value = Worksheets("Logimport").Range("H" & i).Value
.Range("O" & i).Value = Worksheets("Logimport").Range("I" & i).Value
.Range("P" & i).Value = Worksheets("Logimport").Range("J" & i).Value
.Range("Q" & i).Value = Worksheets("Logimport").Range("K" & i).Value
.Range("R" & i).Value = Worksheets("Logimport").Range("L" & i).Value
.Range("S" & i).Value = Worksheets("Logimport").Range("M" & i).Value
.Range("T" & i).Value = Worksheets("Logimport").Range("N" & i).Value
End With
End If
End If
End If
End If
Next k
Next l
End If
schrott = 0
Next i
'Überschriften setzen mit Formatierung
With Worksheets("Gesamtliste")
.Range("A1:L1").Value = Worksheets("R1").Range("A1:L1").Value
.Range("M1:T1").Value = Worksheets("Logimport").Range("G1:N1").Value
.Rows(1).Font.Bold = True
.Columns("A:A").ColumnWidth = 7.43
.Columns("B:B").ColumnWidth = 13.71
.Columns("C:C").ColumnWidth = 8.29
.Columns("D:D").ColumnWidth = 14.43
.Columns("E:E").ColumnWidth = 22.14
.Columns("F:F").ColumnWidth = 6.57
.Columns("G:G").ColumnWidth = 7.43
.Columns("H:H").ColumnWidth = 8.14
.Columns("I:I").ColumnWidth = 9.14
.Columns("J:J").ColumnWidth = 3.43
.Columns("K:K").ColumnWidth = 10.43
.Columns("L:L").ColumnWidth = 7.86
.Columns("M:M").ColumnWidth = 10.29
.Columns("N:N").ColumnWidth = 8.29
.Columns("O:O").ColumnWidth = 9.86
.Columns("P:P").ColumnWidth = 10.57
.Columns("Q:Q").ColumnWidth = 10
.Columns("R:R").ColumnWidth = 10.71
.Columns("S:S").ColumnWidth = 5.43
.Columns("T:T").ColumnWidth = 7.29
End With
End Sub
Also habe das im Sheet Logimport Einträge (derzeit 3 ohne Überschrift) wo in Spalte B jeder Eintrag erst geguckt wird, ob er im Sheet Schrottliste in Spalte A vorhanden ist. Wenn ja, dann soll er zum nächsten Wert des Logimports springen. Wenn nicht, soll er 4 zusammenhängende Werte auf 5 Sheets (R1 - R5) suchen und bei einem Fund die Werte in das Sheet Gesamtliste eintragen.Mir kam auf jeden Fall die Idee, dass er beide (inneren) Schleifen ja abbrechen kann, sobald er den Barcode in der Schrottliste oder die 4 zusammenhängede Werte in den R1-R5 gefunden hat, da die Werte nicht doppelt vorkommen können.
Das würde es etwas performanter machen aber wird glaube ich nicht ausreichen :)
Bin für jede Idee dankbar
Freundliche Grüße