|
Hallo! So auf die schnelle würde ich es nur so ändern. HInweis noch, um den Inhalt deines Array zu behalten musst du Redim Preserve nutzen.
Sub Auswertung()
Dim arr As Variant
Dim Objekt_Nr As Variant
Dim Ergebniss(5000) As Variant
Application.ScreenUpdating = False
Worksheets("Tabelle2").Select
LetzteZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
With Worksheets("Tabelle1")
arr = .Range("P2:P" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
For FortlaufendeNummer = 2 To LetzteZeile
Nr = ActiveSheet.Cells(FortlaufendeNummer, 5).Value
k = 0
For i = 2 To UBound(arr)
If CStr(arr(i, 1)) = Nr Then
ZeileNr = i
Ergebniss(k) = Worksheets("Tabelle1").Cells(i, 1)
k = k + 1
If k > 5000 Then ReDim Preserve Ergebniss(k)
End If
Next
If Ergebniss(0) = "" Then
Sheets("Tabelle2").Cells(FortlaufendeNummer, 17) = "Error"
Erase Ergebniss
End If
Erase Ergebniss
Next
Application.ScreenUpdating = True
End Sub
Das Ganze wird aber nichts an der Geschwindigkeit ändern - eher das Gegenteil. Eine Frage noch. Am Ende wird immer Ergebniss gelöscht. Soll das so sein.
Man könnte auch noch andere Methoden nutzen, um die Daten zu speichern. Welche hängt davon ab, ob die Werte für Ergebniss nur einmal vorkommen und was am Ende damit gemacht werden. Würde da bspw. Arraylisten, Dictionaries etc. geben. VG
|