VBA statt SVerweis

Hallo zusammen.
Ich habe folgende Situation.
Die nachstehende Tabelle wird im jetzigen Zusatnd mit SVerweis ausgeführt. D.h. das die drei Spalten in welcher das Datum eingetragen ist, bei jedem Start aktualisiert wird . Danei greift der SVerweis immer auf dieselbe Datei zurück.
Leider wird diese Datei immer größer und der SVerweis dauert mitunter recht lange.
https://www.herber.de/bbs/user/126132.xlsx
Jetzt meine Frage. Kann mir jemand von euch ein VBA basierten zugriff auf diese Datei (Mengenübertrag, Spalte AA; AB;AC)erstellen damit dieser SVerweis entfallen kann und die Abfrage evtl. über einen Button läuft so daß man diesen manuell starten kann.
Schon jetzt ein großes DANKE an euch. Und allen einen schöne dritten Advent.
Gruß
Hartmut

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Function vbalookup(lookupRange As Range, refRange As Range, dataCol As Long) As Variant 'Extras/Verweise - "Microsoft Scripting Runtime" aktivieren! Dim dict As New Scripting.Dictionary Dim myRow As Range Dim I As Long, J As Long Dim vResults() As Variant ' 1. Build a dictionnary For Each myRow In refRange.Columns(1).Cells ' Append A : B to dictionnary dict.Add myRow.Value, myRow.Offset(0, dataCol - 1).Value Next myRow ' 2. Use it over all lookup data ReDim vResults(1 To lookupRange.Rows.Count, 1 To lookupRange.Columns.Count) As Variant For I = 1 To lookupRange.Rows.Count For J = 1 To lookupRange.Columns.Count If dict.Exists(lookupRange.Cells(I, J).Value) Then vResults(I, J) = dict(lookupRange.Cells(I, J).Value) End If Next J Next I vbalookup = vResults End Function

Hallo
deine Angaben sind mehr als dürftig
für mein Verständnis habe ich es so getestet
zu starten aus der Datei die du hoch geladen hast

Sub test()
Dim c As Range
Dim i As Long
Dim lngLetzte As Long
Dim wbQuelle As Workbook
Dim wksZiel As Worksheet
Set wksZiel = ThisWorkbook.Worksheets("Tabelle1")
lngLetzte = Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = False
Set wbQuelle = Workbooks.Open(Filename:="D:\Test\Mengen?bertrag.xlsx")  'Pfad und Dateiname  _
anpassen
With wbQuelle.Worksheets("Tabelle1")
For i = 5 To lngLetzte
Set c = .Columns(1).Find(wksZiel.Cells(i, 2).Value, LookIn:=xlValues, lookat:= _
xlWhole)
If Not c Is Nothing Then
wksZiel.Cells(i, "K").Value = .Cells(c.Row, "AA").Value
wksZiel.Cells(i, "L").Value = .Cells(c.Row, "AB").Value
wksZiel.Cells(i, "M").Value = .Cells(c.Row, "AC").Value
End If
Next
End With
Workbooks("Mengen?bertrag.xlsx").Close
Application.ScreenUpdating = True
End Sub

MfG Tom
btw: ob das nu wirklich schneller ist mag ich nicht beurteilen

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread