Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA-SVERWEIS mit variablen Dateinamen

VBA-SVERWEIS mit variablen Dateinamen
02.05.2019 10:58:43
Paul
Hallo zusammen!
ich hatte die Frage bereits gestellt und auch eine super Antwort erhalten. Jedoch verstehe ich nicht wie ich in dem alten Beitrag nun antworten kann. (garnicht möglich sobald er im Archiv ist?)
ich will mit einem SVERWEIS Werte aus anderen Excel-Dateien (Quelldateien) ziehen. Welche Dateien durchsucht werden sollen ist abhängig von der jedweiligen Angabe in D3:D21.
Konkret:
Ziel-Excel:
In A3:A21 stehen die Suchkriterien.
In H3:H21 sollen die gefundenen Werte aus den Quelldateien eingetragen werden.
D3:D21 geben einen Hinweis auf die Namen der Quelldateien, welche mit dem SVERWEIS durchsucht werden sollen:
test1
test2
etc.
Quelldateien:
sind alle im Ordner: C:\Users\xxx\Desktop\Test\
Die Dateinamen ähneln sich vom Aufbau:
Info_test1.xlsx
Info_test2.xlsx
etc.
Die Matrix in den Quelldateien ist A4:C27, Spaltenindex 3.
Vielen Dank erstmal an Rob für folgende Lösung:
Option Explicit
Sub LookupValues()
Dim r As Range
Dim wbLookup As Workbook, wbDestiny As Workbook
Dim searchRange As Range
Dim searchValue As Variant
Application.ScreenUpdating = False
On Error GoTo Errhandler
Set wbDestiny = Workbooks("Paul.xlsm") 'HIER NAME DER ZIELDATEI ENTSPRECHEND ÄNDERN
'HINWEIS QUELLDATEIEN R DURCHSCHLEIFEN
For Each r In wbDestiny.Sheets(1).Range("D3:D21")
searchValue = r.Offset(0, -3).Value
Workbooks.Open "C:\Users\admin\Desktop\Info_" & r & ".xlsx" 'HIER ZIELPFAD ANPASSEN
Set wbLookup = Workbooks("Info_" & r & ".xlsx")
Set searchRange = wbLookup.Sheets(1).Range("A4:C27")
r.Offset(0, 4).Value = Application.VLookup(searchValue, searchRange, 3, False)
wbLookup.Close savechanges:=False
Next r
Application.ScreenUpdating = True
Exit Sub
Errhandler:
MsgBox Err.Description, vbCritical
End Sub
Leider passt es noch nicht so ganz:
1. Die Funktion soll nur im Tabellenblatt A (Paul.xlsm) ausgeführt werden und nicht in allen.
2. Es wird immer nur der letzte gefundene Wert angezeigt, die anderen liefern wegen der INDIREKT Funktion jedoch den Fehler #BEZUG! (da die Dateien ja nicht mehr offen sind) --> können die gefundenen Werte fest eingetragen werden?
3. Die Funktion soll standardmäßig beim öffnen der Datei ausgeführt werden-
4. die Funktion soll nur ausgeführt werden für Zeilen in denen in D3:D21 nicht "Projekt" steht.

Schönen Tag,
Paul

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA-SVERWEIS mit variablen Dateinamen
03.05.2019 00:45:24
fcs
Hallo Paul,
im Prinzip sollte der Code von Paul funktionieren.
Es sollten aber noch einige Prüfungen eingebaut werden, um ggf. Fehler abzufangen.
Leider passt es noch nicht so ganz:
1. Die Funktion soll nur im Tabellenblatt A (Paul.xlsm) ausgeführt werden und nicht in allen.

macht Ros Löung. 1 in der entsprechenden Zeile durch den Blattnamen ersetzen
2. Es wird immer nur der letzte gefundene Wert angezeigt, die anderen liefern wegen der INDIREKT Funktion jedoch den Fehler #BEZUG! (da die Dateien ja nicht mehr offen sind) --> können die gefundenen Werte fest eingetragen werden?
Robs Lösung hat nichts mit INDIREKT zu tun. Werte werden fest eingetragen.
3. Die Funktion soll standardmäßig beim öffnen der Datei ausgeführt werden-
Dazu muss unter diese Arbeitsmappe ein entsprechendes Makro eingefügt werden, das die Funktion startet.
4. die Funktion soll nur ausgeführt werden für Zeilen in denen in D3:D21 nicht "Projekt" steht.
Hierzu muss eine weitere Prüfung eingebaut werden, so das diese zeilen übersprungen werden.
LG
Franz

'Code unter DieseArbeitsmappe
Private Sub Workbook_Open()
Call LookupValues
End Sub
'Code in einem allgemeinen Modul
Sub LookupValues()
Dim r As Range
Dim wbLookup As Workbook, wbDestiny As Workbook
Dim searchRange As Range
Dim searchValue As Variant
Dim sPfadQuelle As String, sDatei As String
Dim varWert
Application.ScreenUpdating = False
sPfadQuelle = "C:\Users\xxx\Desktop\Test\"      'Pfad ggf. anpassn
On Error GoTo Errhandler
Set wbDestiny = ThisWorkbook ' Workbooks("Paul.xlsm") 'HIER NAME DER ZIELDATEI ENTSPRECHEND  _
ÄNDERN
'HINWEIS QUELLDATEIEN R DURCHSCHLEIFEN
For Each r In wbDestiny.Sheets("A").Range("D3:D21").Cells 'Blattname ggf anpassen
If r.Text = "Projekt" Then
r.Offset(0, 4).Value = "" '? ggf. Zeile weglasen
Else
sDatei = sPfadQuelle & "Info_" & r.Text & ".xlsx" 'HIER Syntaxt für Dateiname ggf.  _
ANPASSEN
If Dir(sDatei) = "" Then
MsgBox "Datei """ & sDatei & """ niht gefunden"
Else
searchValue = r.Offset(0, -3).Value
Set wbLookup = Workbooks.Open(sDatei, ReadOnly:=True)
Set searchRange = wbLookup.Sheets(1).Range("A4:C27")
varWert = Application.VLookup(searchValue, searchRange, 3, False)
If IsError(varWert) Then
r.Offset(0, 4).Value = "#NV!"
Else
r.Offset(0, 4).Value = varWert
End If
wbLookup.Close savechanges:=False
End If
End If
Next r
GoTo Beenden
Errhandler:
MsgBox Err.Description, vbCritical
Beenden:
Application.ScreenUpdating = True
End Sub

Anzeige
AW: VBA-SVERWEIS mit variablen Dateinamen
03.05.2019 10:08:05
Paul
Hammer gut, vielen dank Franz und Rob!
Das letzte wäre, dass es eigentlich doch praktischer wäre wenn anstatt
For Each r In wbDestiny.Sheets(1).Range("D3:D21")
die Schleife von D3 nur bis zur letzten befüllten Zeile von D laufen würde.
Ich wünsche euch ein tolles Wochenende,
Paul
AW: VBA-SVERWEIS mit variablen Dateinamen
03.05.2019 21:23:21
fcs
Hallo Paul,
Hier Zeilen ergänzen:
        If r.Text = "Projekt" Then
r.Offset(0, 4).Value = "" '? ggf. Zeile weglasen
ElseIf r.Text = "" Then
Exit For
Else

LG
Franz
AW: VBA-SVERWEIS mit variablen Dateinamen
06.05.2019 10:58:43
Paul
vielen vielen Dank!

377 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige