INDEX MATCH in VBA
14.02.2018 09:22:48
Steffen
leider kann ich meinen alten Thread einsehen, aber nicht bearbeiten/beantworten. Rudi Maintaire hat schon einen neuen Code geschrieben, der leider nicht funktioniert.
Ich habe dieses Tabellenblatt: https://www.herber.de/bbs/user/119497.jpg
Unter Broker sind natürlich Namen verborgen, bei Last Update handelt es sich um Daten, bei dem Rest um Zahlen. Ich möchte in die jeweiligen Zellen untereinander die Ergebnisse aus verschiedenen Dateien einpflegen, die immer jeweils im 4. Tabellenblatt der jeweiligen Arbeitsmappe zu finden sind.
Das ist der Code von Rudi:
Sub Zusammenfuehren()
Dim oTargetSheet As Worksheet
Dim oSourceBook As Workbook
Dim oSourceSheet As Worksheet
Dim sPfad As String
Dim sDatei As String
Dim lErgebnisZeile As Long
Dim Suchbereich As Range
Dim rngZeile As Range
Dim Spalte As Range
Dim vntZeile, vntSpalte
Dim SuchKriteriumZeile
Dim SuchKriteriumSpalte
Dim x As Variant
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
Set oSourceSheet = oSourceBook.Sheets(4)
'Datenübertragung
'Datum
Set Suchbereich = oSourceSheet.Range("B5:N13")
Set Zeile = oSourceSheet.Range("B5:B13")
Set Spalte = oSourceSheet.Range("B4:N4")
SuchKriteriumZeile = oTargetSheet.Cells("C3")
SuchKriteriumSpalte = oTargetSheet.Cells("D5")
vntZeile = Application.Match(SuchKriteriumZeile, Zeile, 0)
vntSpalte = Application.Match(SuchKriteriumSpalte, Spalte, 0)
If Not IsError(vntZeile) And Not IsError(vntSpalte) Then
oTargetSheet.Cells(lErgebnisZeile, 4) = Suchbereich.Cells(vntZeile, vntSpalte)
lErgebnisZeile = lErgebnisZeile + 1 'nächste Zeile auf dem Ergebnisblatt
End If
'Schritt 4: Datei wieder schließen und nächste Schleifenrunde
oSourceBook.Close False 'nicht speichern
'Nächste Datei
sDatei = Dir()
lErgebnisZeile = lErgebnisZeile + 1 'nächste Zeile auf dem Ergebnisblatt
Loop
'Variablen aufräumen
Set oTargetSheet = Nothing
Set oSourceSheet = Nothing
Set oSourceBook = Nothing
End Sub
Nach Eingabe steht dort Laufzeitfehler 5. Wenn ich auf Debuggen klicke, wird die Zeile "SuchKriteriumZeile = oTargetSheet.Cells("C3")" gelb markiert. Tausche ich diese mit der nächsten Zeile "SuchKriteriumSpalte = oTargetSheet.Cells("D5")", wird diese gelb markiert. Woran kann das liegen?
Vielen Dank,
Steffen