For/Next mit großen Zahlen beschleunigen
05.05.2022 15:24:41
Seb
ich muss >20.000 Werte in Spalte B einzeln darauf prüfen, ob sie in Spalte A vorkommen. Die Werte für beide Spalten A und B beziehe ich jeweils aus zwei externen Exceldateien, deren Pfad als "Eingabe1" bzw. 2 im ersten Tabellenblatt eingetragen wird. In Spalte C soll anschließend "verfügbar" stehen, sonst "nicht verfügbar". Der Code funktioniert leider nur für kleinere Grenzen in der For-Schleife (bis ca. 1000), danach dauert der Prozess so lange, dass das Programm keine Rückmeldung mehr gibt. Ich habe diverse Befehle eingefügt, um den Prozess zu beschleunigen, bin damit aber noch unzufrieden. Hat jemand eine Idee, um den Code zu vereinfachen?
Sub Datenvergleich()
Dim Eingabe1 As String
Dim Eingabe2 As String
Dim Lastrow1 As Long
Dim Lastrow2 As Long
Dim n As Long
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
On Error GoTo 0
Eingabe1 = Sheets(1).Cells(1, 2).Value
Eingabe2 = Sheets(1).Cells(2, 2).Value
Workbooks.Open (Eingabe1)
Lastrow1 = ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ActiveWorkbook.Sheets(1).Range("A2:A" & Lastrow1).Copy
ActiveWorkbook.Close
ThisWorkbook.Sheets(2).Range("A2").PasteSpecial
ThisWorkbook.Sheets(2).Cells(1, 1).Value = Sheets(1).Cells(1, 1).Value
Workbooks.Open (Eingabe2)
Lastrow2 = ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ActiveWorkbook.Sheets(1).Range("A2:A" & Lastrow2).Copy
ActiveWorkbook.Close
ThisWorkbook.Sheets(2).Range("B2").PasteSpecial
ThisWorkbook.Sheets(2).Cells(1, 2).Value = Sheets(1).Cells(2, 1).Value
Sheets(2).Select
For n = 2 To 300
If WorksheetFunction.CountIf(Range("A:A"), Cells(n, 2)) > 0 Then
Cells(n, 3).Value = "verfügbar"
Else
Cells(n, 3).Value = "nicht verfügbar"
End If
Next n
Columns("A:C").EntireColumn.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub