SVERWEIS mit horizontalen Suchbegriffen
06.05.2019 11:58:21
Paul
dank eurer Hilfe habe ich nun schon einen Sverweis auf eine externe Dateien mit dynamischen Dateinamen hinbekommen. Vielen Dank nochmal!
Nun versuche ich mich an einem Verweis, bei dem die Suchkriterien horizontal in einer Zeile stehen.
Es ist eigentlich eine einfache Matrix mit der vertikalen Achse Namen und der horizontalen Achse Monate, die befüllt werden soll.
Die Namen in der Spalte B geben an welche Dateien durchsucht werden sollen. durch die Spalte B definiert. Die Dateinamen sind immer wie folgt aufgebaut: Info_"Name".xlsx.
Nun soll für jeden Namen und Monat (C2:N2) in der entsprechenden Quelldatei (Info_"Name") in der Matrix E3:F14 den entsprechenden Wert gefunden werden.
E3:F14 hat in der Spalte E die Monate und in F die zu findenden Daten. (Spaltenindex 2)
Ich habe versucht den Code unten entsprechend zu verändern, weil er eigentlich schon sehr schöne Sicherheitsmechanismen enthält, aber es bisher nicht hinbekommen :(
Vielen Dank vorab für eure Unterstützung.
'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