Als Code benutze ich den nachfolgenden. Zu meinem Problem: Ich kann den SVerweis einmalig durchführen. Sobald ich aber einen zweiten SVerweis als neuen Sub mit dem gleichen Code durchführen möchte, werden für beide Verweise keine Ergebnisse mehr zurückgegeben.
Mein Laienwissen sagt mir, dass ich vermutlich die Matrix/Arrays nach jedem durchgeführten SVerweis leeren bzw löschen muss, leider blieben meine bisherigen Versuche aber Erfolglos.
Ich wäre sehr dankbar für eure Hilfe!
Public Sub machs()
Dim MyDic As Object
Dim Matrix As Variant
Dim Suchkriterium As Variant
Dim L As Long
Dim Ausgabe As Variant
Set MyDic = CreateObject("Scripting.Dictionary") 'Verweis auf das Dictionary Object setzen
Matrix = Sheets("Tabelle1").Range("A:Z") 'Wie in der Tabellenfunktion =Sverweis(). Anpassen
Suchkriterium = Sheets("Tabelle2").Range("A1:A10000") 'Hier werden deine Suchkriterien _
angegeben. Anpassen.
For L = 1 To UBound(Matrix)
MyDic(Matrix(L, 1)) = Array(Matrix(L, 2), Matrix(L, 3), Matrix(L, 4), Matrix(L, 5))
'_________________________Spaltenindex2_Spaltenindex3_Spaltenindex4_Spaltenindex5
Next
Redim Ausgabe(1 To UBound(Suchkriterium), 1 To 5) 'Ausgabe Array dimensionieren
'Genauso viele Zeilen wie Suchkriterien, 5 Spalten.
On Error Resume Next
For L = 1 To UBound(Suchkriterium)
Ausgabe(L, 1) = Suchkriterium(L, 1)
Ausgabe(L, 2) = MyDic(Suchkriterium(L, 1))(0)
Ausgabe(L, 3) = MyDic(Suchkriterium(L, 1))(1)
Ausgabe(L, 4) = MyDic(Suchkriterium(L, 1))(2)
Ausgabe(L, 5) = MyDic(Suchkriterium(L, 1))(3)
Next
Sheets("Tabelle3").Range("A1").Resize(UBound(Suchkriterium), 5) = Ausgabe 'Hier werden die _
Ergebnisse ausgegeben.Anpassen.
End Sub