Fehlermeldung bei: Excel SVerweis per Makro

Computer: Software & Programmierung Visual Basic
#1

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ß

#2

Hallo Meri,

Und zwar hab ich in Excel einen SVerweis per Makro angewand
und es ging fast, jetzt

was heißt „…es ging fast, jetzt…“? Ging es je?
Im Code kann ich keinen SVerweis entdecken.

bring es einen Fehler „Laufzeitfehler
‚9‘: Index außerhalb des gültigen Bereichs“ der mir nichts
sagt.

Du willst irgendwas ansprechen was es nicht gibt.

In welcher Codezelie kommt der Fehler?

Und wenn du Code postest benutze bitte den pre-Tag.

Gruß
Reinhard

#3

Hallo Reinhard,

Also es ging eben nicht, den es kam dieser Fehler: Laufzeitfehler in dieser Zeile:

While Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1SuchSpalte) „“ _
And Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1SuchSpalte) Cells(i, D2SuchwertSpalte)

Danke fürs helfen.
P.S.Das mit dem in Code form schreiben oder Zitieren hab ich noch nicht verstanden wie das geht.

#4

Hallo Meri,

Also es ging eben nicht, den es kam dieser Fehler:
Laufzeitfehler in dieser Zeile:

While
Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j,
D1SuchSpalte) „“ _
And Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j,
D1SuchSpalte) Cells(i, D2SuchwertSpalte)

setze einen Haltepunkt bei dem „While…“, setz den Curser beliebig in den Code, dann drücke F5. Dann schau dir über Ansicht–Lokalfenster oder mit der maus langsam über die einzelnen Variablen stellen, deren Werte an.
Sind die alle korrekt, bei Strings vielleicht Leerzeichen drin, usw.

P.S.Das mit dem in Code form schreiben oder Zitieren hab ich
noch nicht verstanden wie das geht.

Der Pre-Tag wird unterhalb des Eingabefensters erläutert. Ober halb des Eingabefensters siehst du die hier erlaubten (Html-) Tags.
Als Ergebnis bleiben deine Codeeinrückungen erhalten, wie nachstehend ersichtlich

Gruß
Reinhard

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