Hallo,
ich bin auf der Suche nach einer Lösung für folgendes Problem:
Und zwar hab ich in Excel einen SVerweis per Makro angewand und es ging fast, jetzt bring es einen Fehler „Laufzeitfehler ‚9‘: Index außerhalb des gültigen Bereichs“ der mir nichts sagt.
Weis jemand weiter. Mein Programmbaustein ist unten:
Option Explicit
Private Sub btBerechnen_Click()
Dim a, WorkbookSenke, WorkbookQuelle, DateiPfad, DateiName As Variant
Dim PosBackSlash, i, j, D1StartZeile, D1StartSpalte, D2StartZeile, D2StartSpalte, D2D1Zeile, D2D1Spalte, D1SuchSpalte, D1DatenSpalte, D2Datenspalte, D2SuchwertSpalte As Integer
’ Aktuelles Workbook feststellen
WorkbookSenke = ActiveWorkbook.Name
’ Hier werden die Startwerte gesetzt
’ allgemein gilt bei den Splatenwerten 1=A, 2=B, 3=C etc
’ Datei1
D1StartZeile = 2 'Zeile, in der in D1 die Suche beginnt
D1SuchSpalte = 3 'Spalte, in der in D1 gesucht wird
D1DatenSpalte = 8 'Spalte, aus der in D1 die Daten kopiert werden
’ Datei2
D2StartZeile = 4 'Zeile, bei der die Verarbeitung in Datei 2 beginnt
D2SuchwertSpalte = 5 'Spalte, in der in D2 der zu suchende Wert steht
D2Datenspalte = 10 'Spalte, in der in D2 die aus D1 kopierten Daten eingetragen werden sollen
’ Wo ist in Datie 2 der Pfad von Datei 1 konfiguriert
D2D1Zeile = 1
D2D1Spalte = 10
’ Ermittle DateiPfad und DateiName
DateiPfad = Cells(D2D1Zeile, D2D1Spalte)
PosBackSlash = InStr(1, DateiPfad, „“, 1)
DateiName = Mid(DateiPfad, PosBackSlash + 1)
’ Öffne Datei
On Error Resume Next
Workbooks.Open Filename:=DateiPfad
If Err.Number 0 Then
’ Fehlermeldung
a = MsgBox(DateiPfad & " existiert nicht", vbOKOnly, „Abbruch der Verarbeitung“)
Exit Sub
Else
On Error GoTo 0
WorkbookQuelle = ActiveWorkbook.Name
End If
Workbooks(WorkbookSenke).Activate
i = D2StartZeile
While Cells(i, D2SuchwertSpalte) „“
j = D1StartZeile
While Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1SuchSpalte) „“ _
And Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1SuchSpalte) Cells(i, D2SuchwertSpalte)
j = j + 1
Wend
If Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1SuchSpalte) = Cells(i, D2SuchwertSpalte) Then
Cells(i, D2Datenspalte) = Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1DatenSpalte)
Else
Cells(i, D2Datenspalte) = „“
End If
i = i + 1
Wend
'QuellDatei schließen
Workbooks(WorkbookQuelle).Close SaveChanges:=False
End Sub
Bin für jede Hilfe dankbar!
Danke & Gruß