|  
                                             
	Moin nochmal! Hier mal noch ein Code der mit einer andere Variante - dictionary - läuft. Dabei brauchst du dich nicht um das erweitern des Array etc. kümmern, sondern packst die Treffer in ein dictonary. Zum Nachlesen noch etwas Material: 
	https://excelmacromastery.com/vba-dictionary/ 
	http://www.snb-vba.eu/VBA_Dictionary_en.html 
	Evtl. mal noch schauen, ob die Zuordnung der Spalten noch passt. In einem Code hattest du die Anzahl der Spalte B genommen aber aus E die Werte (iim Blatt 2). Am Ende wird entweder Error ausgegeben oder das Array mit den Treffern getrennt durch ";" . Die Werte aus Blatt 1 (Spalte A und P) sind auch in Variablen gepackt. Geht dadurch schneller, als wenn du auf das Blatt zugreifst. VG 
	  
Sub Auswertung()
 
Dim Liste  'Spalte P
Dim Suche  'Nummern
Dim Verweis 'Spalte A
Dim letzte As Long
Dim FortlaufendeNummer  As Long
Dim LetzteZeile As Long
Dim i As Long
Dim treffer As String
Dim Objekt_Nr As Variant
Dim result As String
Dim Ergebniss As Object
Set Ergebniss = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
    letzte = .Cells(.Rows.Count, "P").End(xlUp).Row
    Liste = .Range("P1:P" & letzte)
    Verweis = .Range("A1:A" & letzte)
End With
Application.ScreenUpdating = False
Worksheets("Tabelle2").Select
LetzteZeile = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row  'Spalte E oder B in Blatt 2??
Suche = Worksheets("Tabelle2").Range("E1:E" & LetzteZeile)
For FortlaufendeNummer = 2 To LetzteZeile
    Nr = Suche(FortlaufendeNummer, 1)
   
    For i = 2 To UBound(Liste)
 
        If CStr(Liste(i, 1)) = Nr Then
            Ergebniss.Add i, CStr(Verweis(i, 1))
            Debug.Print Ergebniss.items()(Ergebniss.Count - 1)
        End If
        
    Next
          
    If Ergebniss.Count = 0 Then
 
        Sheets("Tabelle2").Cells(FortlaufendeNummer, 17) = "Error"
        Ergebniss.RemoveAll
    Else
    'ergebnis ausgeben
        Sheets("Tabelle2").Cells(FortlaufendeNummer, 17) = Join(Ergebniss.items, ";")
    End If
    Ergebniss.RemoveAll
Next
 
 
Application.ScreenUpdating = True
Set Ergebniss = Nothing
End Sub
	  
     |