INDEX MATCH in VBA mit unterschiedlichen Dateien
31.01.2018 15:04:34
Steffen
Ich möchte in einem Excel-Tabellenblatt (Testmappe, Tabelle1) per INDEX und MATCH Zahlen bzw. Namen aus anderen Excel-Dateien extrahieren. Diese sind immer in der vierten Tabelle der jeweiligen Datei, die Tabellen haben aber unterschiedliche Namen.
So lautet der Excel-Befehl, wenn ich ihn ohne VBA schreibe:
=INDEX([Datenmappe.xlsx]BspBlatt!$B$5:$N$13;VERGLEICH($C$3;[Datenmappe.xlsx]BspBlatt!$B$5:$B$13;0); VERGLEICH(D$5;[Datenmappe.xlsx]BspBlatt!$B$4:$N$4;0))
Dieser Befehl funktioniert auch wunderbar.
Nach längerem Suchen und Probieren habe ich diesen Code geschrieben. In diesem Beispiel suche ich nach einem Datum (ich wollte den Befehl oben in VBA umsetzen).
Sub Zusammenfuehren()
Dim oTargetSheet As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Dim lErgebnisZeile As Long
Application.ScreenUpdating = False
'Zieldatei festlegen
Set oTargetSheet = ActiveWorkbook.Sheets(1)
lErgebnisZeile = 6 'Ergebnisse eintragen ab Zeile 6
'Schleife über alle Excel Dateien in einem Verzeichnis
sPfad = "\\STUDENTS_SMB\Bannenbe\Desktop\Beispielordner\"
sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
Do While sDatei ""
'öffnen der Datei und Datenübertragung
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
'Datenübertragung
'Datum
Dim Suchbereich As Range
Dim Zeile As Range
Dim Spalte As Range
Dim x As Variant
Set Suchbereich = oSourceBook.Sheets(4).Range("B5:N13")
Set Suchkriterium = oTargetSheet.Sheets(1).Cells("C3")
Set Zeile = oSourceBook.Sheets(4).Range("B5:B13")
Set Spalte = oSourceBook.Sheets(4).Range("B:N4")
With Application.WorksheetFunction
oTargetSheet.Cells(lErgebnisZeile, 4).Value
x = .index(Suchbereich, .Match(Suchkriterium, Zeile, 0), .Match(Suchkriterium, Spalte, 0),1) _
_
End With
'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
oSourceBook.Close False 'nicht speichern
'Nächste Datei
sDatei = Dir()
lErgebnisZeile = lErgebnisZeile + 1 'nächste Zeile auf dem Ergebnisblatt
Loop
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
'Variablen aufräumen
Set oTargetSheet = Nothing
Set oSourceBook = Nothing
End Sub
Es erscheint leider immer Laufzeitfehler '438'
Es wäre außerdem klasse, wenn man etwas einbauen könnte, das zunächst danach fragt, ob es diesen Namen überhaupt in dem Suchbereich gibt und ggf. direkt zur nächsten Datei übergeht.
Ich wäre sehr sehr dankbar für Hilfs- und Verbesserungsvorschläge
Viele Grüße,
Steffen
