Office: VBA schneller SVERWEIS

Hallo zuasmmen,

Folgende Problem:

Tabellen1 A1:A100 stehen verschiedene Werte die Werte kommen nicht doppelt vor.

Tabelle2 A1:B100 stehen verschiedene Werte.

SO:

Ich brauche das unbedingt in VBA und zwar am besten keine for Next schleife weil es in Wirklichkeit viel mehr Zeilen und Spalten sind.

Alle Werte aus Tabelle1 A1:a100 sollen mit Tabelle2 A1:A100 verglichen werden kommt ein Wert in Tabelle1 Spalte A auch in Tabelle2 SpalteA vor so soll in Tabelle1 zeile X der Wert von Tabelle2 Spalte B übertragen werden.

Hm hoffe ich habe mich eingermaßen verständlich ausgedrückt.
Falls nicht hänge ich schnell ne BspD. an.

Gruß

 

aus der Excel 2007-Hilfefunktion: "Vertikales/Horizontals Suchen von Werten mit Hilfe einer Liste mit genau einer Übereinstimmung"
Zugehörig sind dazu die Funktionen SVerweis und WVerweis.

Wenn das Ganze über VBA gelöst werden soll, bleibt einem nur die Möglichkeit, über eine Schleife alle notwendigen Zellen zu durchlaufen.
Ob das nun über For-Next oder Do-Loop oder gar While konstruiert wird, spielt dabei eher eine untergeordnete Rolle und hängt davon ab, wann eine Bedingung geprüft werden soll.

 

Hallo danke für deine Antwort,

ich dachte eher an an so was

Code:

Cells.Replace What:="1", Replacement:="2", LookAt:=xlPart,[/quote]

was wäre den die schnellste VBA SChleifen Lösung?

 

Grüezi Gook

Schneller als ein SVERWEIS() wirst Du mit VBA wohl kaum etwas hinkriegen....

Desen kannst Du ja auch in VBA verwenden und dann das Ergebnis in die betreffende Zelle schreiben lassen.

 

Hallo Thomas,

ok mir ist klar der SVERWEIS sehr schnell ist.

Wie sollte ich ihn dann in VBA verwenden mit Application.WorksheetFunction.... ???
Für ein anderes Project habe ich folgenden Code Verwenden diese war ca 10-15 mal schneller als mein SVERWEIS Formellösung.

Code:

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("Artikelspa").Range("A:D") 'Wie in der Tabellenfunktion =Sverweis(). Anpassen
Suchkriterium = Sheets("Artikelstamm").Range("A1:A50000") 'Hier werden deine Suchkriterien angegeben. Anpassen.
For L = 1 To UBound(Matrix)
    MyDic(Matrix(L, 1)) = Array(Matrix(L, 2), Matrix(L, 3))
    '_________________________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("Artikelstamm").Range("K1").Resize(UBound(Suchkriterium), 5) = Ausgabe 'Hier werden die Ergebnisse ausgegeben.Anpassen.

Deswegen meine Frage nach einer schnellen VBA lösung.

Vielen dank für deine Antwort!

Gruß

 

Eine vielleicht nicht ganz saubere, aber durchaus schnell funktionierende Möglichkeit:

Setze mit

Code:

range("b1").formulalocal="=sverweis(a1;$y$1:$z$100;2;falsch)"

eine Formel in die oberste Zelle. Dann nimm diese Zelle und kopiere sie mit

Code:

range("b1").copy destination:=range("b2:b100")

auf die restlichen Zellen der Spalte. Und ggf. als krönenden Abschluß kannst Du noch die Formeln durch Werte ersetzen, um Neuberechnungen zu verhindern:

Code:

range("b1:b100").copy
range("b1:b100").pastespecial paste:=xlpastevalues

Sonst bleibt Dir eigentlich nur die Schleife mit application.worksheetfunction, ja...

Gruß, Michael