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
|