Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 18:41:19
vba Zeilen duplizieren ab aktiver Zeile bis letzte Zeile
25.04.2024 18:22:55
Zeilen mit bestimmtem Datum in andere Mappe übertragen
25.04.2024 18:14:45
VBA - Excell - Kopie und "Diebstahl" Schützen
25.04.2024 17:49:39
Bedingte Formatierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1748to1752
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1748to1752
1748to1752
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Fehler bei IF Schleifen

Fehler bei IF Schleifen
07.04.2020 12:22:34
Debugger
Hallo zusammen,
bei folgender Schleife, welche Dokumente kopieren soll und diese anschließend beschriften, ergeben sich Fehler bei den IFs am Schluss.....
Die kursiv markierten IFs und Nexts werden komischerweise als
"End IF ohne IF/Next ohne For"
deklariert.
Leider finde ich auch nach mehrmaligen Probieren nicht heraus was, wieso er mir plötzlich hier einen Fehler ausgibt. Ich habe dabei den fett-gedruckten Code eingefügt, davor lief die Schleife ohne Probleme durch.
Freue mich über Hilfe ....
VG
Debugger

Sub DokumenteAnlegen()
Dim pre, Projekt As String
pre = ActiveWorkbook.Sheets("Eingabefenster").Cells(7, 2)
Projekt = ActiveWorkbook.Sheets("Eingabefenster").Range("B5").Value
Dim x As Integer
Dim m As Integer
Dim I As Integer
Dim a As Integer
Dim b As Integer
Dim Dokumente As Variant
Dim DokumenteSource As Variant
m = Sheets("Dokumente").Cells(1, 1).End(xlToRight).Column
x = 1
For x = 1 To m
I = Sheets("Dokumente").Cells(1, x).End(xlUp).Row
Dokumente = (Sheets("Dokumente").Cells(2, x).Value)
For I = 1 To x
With Worksheets("Quelle")
a = .Cells(1, x).CurrentRegion.Rows.Count
For b = 1 To a
DokumenteSource = (Sheets("Quelle").Cells(b, x))
Dokumente = (Sheets("Dokumente").Cells(b + 1, x))
If Dokumente  "" Then
If (Dir(Sheets("Dokumente").Cells(1, x).Value)) = "" Then
If DokumenteSource  "" Then
FileCopy DokumenteSource, Dokumente
If Right(Dokumente, 5) = ".docx" Then
 Const wdReplaceAll = 2
Dim AppWD As Object, AppDoc As Object
Dokumente = ActiveWorkbook.Sheets("Dokumente").Range("C2"). _
Value
If Dir(Dokumente)  "" Then
Set AppWD = CreateObject("Word.Application") 'Word als Object    _
_
_
starten
If Not AppWD Is Nothing Then
AppWD.Visible = True
Set AppDoc = AppWD.documents.Open(Dokumente)
If Not AppDoc Is Nothing Then
With AppDoc.Range.Find
.Text = "Test"
.MatchCase = True
.Replacement.Highlight = True
.Replacement.Text = ActiveWorkbook.Sheets("Eingabefenster"). _
Range("B5").Value
.Execute Replace:=wdReplaceAll
End With
Else
Dim strText As String, Wsh As Worksheet
Workbooks.Open (Dokumente)
strText = "Ersatz"
For Each Wsh In ActiveWorkbook.Worksheets
Wsh.UsedRange.Replace "Test", strText, xlPart
Else
MsgBox "Die zu öffnende Dokumentdatei wurde nicht gefunden!", vbCritical, "  _
_
_
Word-Datei öffnen"
End If
End If
Next b
Next x
Next m

End Sub

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fehler bei IF Schleifen
07.04.2020 12:26:59
Hajo_Zi
arbeite mit Einrückungen da fällt auf was falsch ist. 
Option Explicit
Sub DokumenteAnlegen()
Dim pre, Projekt As String
pre = ActiveWorkbook.Sheets("Eingabefenster").Cells(7, 2)
Projekt = ActiveWorkbook.Sheets("Eingabefenster").Range("B5").Value
Dim x As Integer
Dim m As Integer
Dim I As Integer
Dim a As Integer
Dim b As Integer
Dim Dokumente As Variant
Dim DokumenteSource As Variant
m = Sheets("Dokumente").Cells(1, 1).End(xlToRight).Column
x = 1
For x = 1 To m
I = Sheets("Dokumente").Cells(1, x).End(xlUp).Row
Dokumente = (Sheets("Dokumente").Cells(2, x).Value)
For I = 1 To x
With Worksheets("Quelle")
a = .Cells(1, x).CurrentRegion.Rows.Count
For b = 1 To a
DokumenteSource = (Sheets("Quelle").Cells(b, x))
Dokumente = (Sheets("Dokumente").Cells(b + 1, x))
If Dokumente  "" Then
If (Dir(Sheets("Dokumente").Cells(1, x).Value)) = "" Then
If DokumenteSource  "" Then
FileCopy DokumenteSource, Dokumente
If Right(Dokumente, 5) = ".docx" Then
Const wdReplaceAll = 2
Dim AppWD As Object, AppDoc As Object
Dokumente = ActiveWorkbook.Sheets("Dokumente").Range("C2"). _
Value
If Dir(Dokumente)  "" Then
Set AppWD = CreateObject("Word.Application") 'Word als  _
Object starten
If Not AppWD Is Nothing Then
AppWD.Visible = True
Set AppDoc = AppWD.documents.Open(Dokumente)
If Not AppDoc Is Nothing Then
With AppDoc.Range.Find
.Text = "Test"
.MatchCase = True
.Replacement.Highlight = True
.Replacement.Text = ActiveWorkbook.Sheets(" _
Eingabefenster").Range("B5").Value
.Execute Replace:=wdReplaceAll
End With
Else
Dim strText As String, Wsh As Worksheet
Workbooks.Open (Dokumente)
strText = "Ersatz"
For Each Wsh In ActiveWorkbook.Worksheets
Wsh.UsedRange.Replace "Test", strText,  _
xlPart
Else
MsgBox "Die zu öffnende Dokumentdatei wurde  _
nicht gefunden!", vbCritical, "Word-Datei öffnen"
End If
End If
Next b
Next x
Next m
End Sub

Anzeige
AW: Fehler bei IF Schleifen
07.04.2020 12:31:47
Hajo_Zi
arbeite mit Einrückungen da fällt auf was falsch ist. 
Option Explicit
Sub DokumenteAnlegen()
Dim pre, Projekt As String
pre = ActiveWorkbook.Sheets("Eingabefenster").Cells(7, 2)
Projekt = ActiveWorkbook.Sheets("Eingabefenster").Range("B5").Value
Dim x As Integer
Dim m As Integer
Dim I As Integer
Dim a As Integer
Dim b As Integer
Dim Dokumente As Variant
Dim DokumenteSource As Variant
m = Sheets("Dokumente").Cells(1, 1).End(xlToRight).Column
x = 1
For x = 1 To m
I = Sheets("Dokumente").Cells(1, x).End(xlUp).Row
Dokumente = (Sheets("Dokumente").Cells(2, x).Value)
For I = 1 To x
With Worksheets("Quelle")
a = .Cells(1, x).CurrentRegion.Rows.Count
For b = 1 To a
DokumenteSource = (Sheets("Quelle").Cells(b, x))
Dokumente = (Sheets("Dokumente").Cells(b + 1, x))
If Dokumente  "" Then
If (Dir(Sheets("Dokumente").Cells(1, x).Value)) = "" Then
If DokumenteSource  "" Then
FileCopy DokumenteSource, Dokumente
If Right(Dokumente, 5) = ".docx" Then
Const wdReplaceAll = 2
Dim AppWD As Object, AppDoc As Object
Dokumente = ActiveWorkbook.Sheets("Dokumente").Range("C2"). _
Value
If Dir(Dokumente)  "" Then
Set AppWD = CreateObject("Word.Application") 'Word als  _
Object starten
If Not AppWD Is Nothing Then
AppWD.Visible = True
Set AppDoc = AppWD.documents.Open(Dokumente)
If Not AppDoc Is Nothing Then
With AppDoc.Range.Find
.Text = "Test"
.MatchCase = True
.Replacement.Highlight = True
.Replacement.Text = ActiveWorkbook.Sheets(" _
Eingabefenster").Range("B5").Value
.Execute Replace:=wdReplaceAll
End With
Else
Dim strText As String, Wsh As Worksheet
Workbooks.Open (Dokumente)
strText = "Ersatz"
For Each Wsh In ActiveWorkbook.Worksheets
Wsh.UsedRange.Replace "Test", strText,  _
xlPart
Else
MsgBox "Die zu öffnende Dokumentdatei wurde  _
nicht gefunden!", vbCritical, "Word-Datei öffnen"
End If
End If
Next b
Next x
Next m
End Sub

Anzeige
AW: Fehler bei IF Schleifen
07.04.2020 12:37:20
Debugger
Hallo Hajo,
danke für deine Antwort:
habe ich bereits gemacht, leider kommt immer noch der gleiche Fehler.
'Anlegen der einzelnen Dokumente 
Sub DokumenteAnlegen()
Dim pre, Projekt As String
pre = ActiveWorkbook.Sheets("Eingabefenster").Cells(7, 2)
Projekt = ActiveWorkbook.Sheets("Eingabefenster").Range("B5").Value
Dim x As Integer
Dim m As Integer
Dim I As Integer
Dim a As Integer
Dim b As Integer
Dim Dokumente As Variant
Dim DokumenteSource As Variant
m = Sheets("Dokumente").Cells(1, 1).End(xlToRight).Column
x = 1
For x = 1 To m
I = Sheets("Dokumente").Cells(1, x).End(xlUp).Row
Dokumente = (Sheets("Dokumente").Cells(2, x).Value)
For I = 1 To x
With Worksheets("Quelle")
a = .Cells(1, x).CurrentRegion.Rows.Count
For b = 1 To a
DokumenteSource = (Sheets("Quelle").Cells(b, x))
Dokumente = (Sheets("Dokumente").Cells(b + 1, x))
If Dokumente  "" Then
If (Dir(Sheets("Dokumente").Cells(1, x).Value)) = "" Then
If DokumenteSource  "" Then
FileCopy DokumenteSource, Dokumente
If Right(Dokumente, 5) = ".docx" Then
Const wdReplaceAll = 2
Dim AppWD As Object, AppDoc As Object
Dokumente = ActiveWorkbook.Sheets("Dokumente").Range("C2"). _
Value
If Dir(Dokumente)  "" Then
Set AppWD = CreateObject("Word.Application") 'Word als Object  _
starten
If Not AppWD Is Nothing Then
AppWD.Visible = True
Set AppDoc = AppWD.documents.Open(Dokumente)
If Not AppDoc Is Nothing Then
With AppDoc.Range.Find
.Text = "test"
.MatchCase = True
.Replacement.Highlight = True
.Replacement.Text = ActiveWorkbook.Sheets("Eingabefenster"). _
Range("B5").Value
.Execute Replace:=wdReplaceAll
End With
Else
Dim strText As String, Wsh As Worksheet
Workbooks.Open (Dokumente)
strText = "Ersatz"
For Each Wsh In ActiveWorkbook.Worksheets
Wsh.UsedRange.Replace "test", strText, xlPart
End If
Else
MsgBox "Die zu öffnende Dokumentdatei wurde nicht gefunden!", vbCritical, " _
Word-Datei öffnen"
End If
End If
End If
Next b
Next x
Next m
End Sub
VG
Peter
Anzeige
AW: Fehler bei IF Schleifen
07.04.2020 13:39:54
Luschi
Hallo Debugger,
in diesem Codeblock 

Else
Dim strText As String, Wsh As Worksheet
Workbooks.Open (Dokumente)
strText = "Ersatz"
For Each Wsh In ActiveWorkbook.Worksheets
Wsh.UsedRange.Replace "test", strText, xlPart
End If
hat die For-Schleife keine Next Whs-Anweisung
Gruß von Luschi
aus klein-Paris
AW: Fehler bei IF Schleifen
07.04.2020 13:58:36
Debugger
Hallo Luschi,
danke für deine Antwort.
Leider verstehe ich es nicht ganz. In dem vorherigen Code-Block hat die For Anweisung doch auch keine Next Whs Anweisung....
Wie würdest du den Block denn ändern?
VG
Debugger
Anzeige
AW: Fehler bei IF Schleifen
07.04.2020 14:17:22
Daniel
Hi
Die Fehlermeldung ist hier etwas verwirrend.
Das liegt an folgendem:
1. die Codeprüfung erfolgt immer linear von oben nach unten, bis zum ersten Fehler der auffällt.
2. alle For-Nex, If-End if, with-End With, Do-Loop usw.
müssen immer ineinander geschachtelt werden wie Matroschkas.
Dh der Block/Schleife welcher als erstes aufgemacht wird, muss als letztes geschlossen werden.
In dem Beispiel von Luschi gehört aus Sicht des Interpreters das End If in die For-Next-Schleife hinein, da das Next noch nicht gekommen ist. Dh. das dazugehörige If müsste zwischen dem For und dem EndIf stehen, weil der If-Block sich vollständig innerhalb der Schleife befinden muss.
Daher ist der erste auftretende Fehler das fehlende If, obwohl eigentlich das Next fehlt, dies könnte aber später noch im Code erscheinen, aber soweit ist die Prüfung des Codes noch nicht.
Gruß Daniel
Anzeige
AW: Fehler bei IF Schleifen
07.04.2020 15:03:53
Debugger
Hallo Daniel,
besten Dank für deine Antwort.
Das ineinanderschachteln habe ich an und für sich schon verstanden, allerdings verstehe ich den Fehler schlichtweg nicht. Auch denke ich, dass so wie du es beschrieben hast, ich sowohl das IF als auch das END-IF korrekt in die Next Schleife gesetzt habe...
Ich habe nochmal unten die Schleife sowie die Ifs markiert.
VG
Sub DokumenteAnlegen()
Dim pre, Projekt As String
pre = ActiveWorkbook.Sheets("Eingabefenster").Cells(7, 2)
Projekt = ActiveWorkbook.Sheets("Eingabefenster").Range("B5").Value
Dim x As Integer
Dim m As Integer
Dim I As Integer
Dim a As Integer
Dim b As Integer
Dim Dokumente As Variant
Dim DokumenteSource As Variant
m = Sheets("Dokumente").Cells(1, 1).End(xlToRight).Column
x = 1
For x = 1 To m
I = Sheets("Dokumente").Cells(1, x).End(xlUp).Row
Dokumente = (Sheets("Dokumente").Cells(2, x).Value)
For I = 1 To x
With Worksheets("Quelle")
a = .Cells(1, x).CurrentRegion.Rows.Count
For b = 1 To a
DokumenteSource = (Sheets("Quelle").Cells(b, x))
Dokumente = (Sheets("Dokumente").Cells(b + 1, x))
If Dokumente  "" Then
If (Dir(Sheets("Dokumente").Cells(1, x).Value)) = "" Then
If DokumenteSource  "" Then
FileCopy DokumenteSource, Dokumente
If Right(Dokumente, 5) = ".docx" Then
Const wdReplaceAll = 2
Dim AppWD As Object, AppDoc As Object
Dokumente = ActiveWorkbook.Sheets("Dokumente").Range("C2").  _
_
Value
If Dir(Dokumente)  "" Then
Set AppWD = CreateObject("Word.Application") 'Word als  _
Object  _
starten
If Not AppWD Is Nothing Then
AppWD.Visible = True
Set AppDoc = AppWD.documents.Open(Dokumente)
If Not AppDoc Is Nothing Then
With AppDoc.Range.Find
.Text = "test"
.MatchCase = True
.Replacement.Highlight = True
.Replacement.Text = ActiveWorkbook.Sheets("Eingabefenster"). _
_
Range("B5").Value
.Execute Replace:=wdReplaceAll
End With
Else
Dim strText As String, Wsh As Worksheet
Workbooks.Open (Dokumente)
strText = "Ersatz"
For Each Wsh In ActiveWorkbook.Worksheets
Wsh.UsedRange.Replace "test", strText, xlPart
End If
Else
MsgBox "Die zu öffnende Dokumentdatei wurde nicht gefunden!", vbCritical, _
" _
Word-Datei öffnen"
End If
End If
End If
Next b
Next x
Next m
End Sub

Anzeige
AW: Fehler bei IF Schleifen
07.04.2020 15:25:24
Daniel
Hi
Deine Angaben des Schleifenzählers passen nicht bei den letzten beiden Next!
Das entscheidende aber ist, dass das End With für With Worksheets("Quelle") fehlt.
Das müsste zwischen dem vor- und vorvorletzten Next stehen.
Oder lass es weg, wenn du das Objekt nur einmal verwendest, kannst du dir das With auch sparen, vor allem, wenn du eh schon so viele Schachtelungen hast.
Gruß Daniel
AW: Fehler bei IF Schleifen
07.04.2020 15:32:36
Debugger
Hallo Daniel,
besten Dank für deine Antwort.
Anbei der Code mit deinen Änderungen.
'Anlegen der einzelnen Dokumente 
Sub DokumenteAnlegen()
Dim pre, Projekt As String
pre = ActiveWorkbook.Sheets("Eingabefenster").Cells(7, 2)
Projekt = ActiveWorkbook.Sheets("Eingabefenster").Range("B5").Value
Dim x As Integer
Dim m As Integer
Dim I As Integer
Dim a As Integer
Dim b As Integer
Dim Dokumente As Variant
Dim DokumenteSource As Variant
m = Sheets("Dokumente").Cells(1, 1).End(xlToRight).Column
x = 1
For x = 1 To m
I = Sheets("Dokumente").Cells(1, x).End(xlUp).Row
Dokumente = (Sheets("Dokumente").Cells(2, x).Value)
For I = 1 To x
With Worksheets("Quelle")
a = .Cells(1, x).CurrentRegion.Rows.Count
For b = 1 To a
DokumenteSource = (Sheets("Quelle").Cells(b, x))
Dokumente = (Sheets("Dokumente").Cells(b + 1, x))
If Dokumente  "" Then
If (Dir(Sheets("Dokumente").Cells(1, x).Value)) = "" Then
If DokumenteSource  "" Then
FileCopy DokumenteSource, Dokumente
If Right(Dokumente, 5) = ".docx" Then
Const wdReplaceAll = 2
Dim AppWD As Object, AppDoc As Object
Dokumente = ActiveWorkbook.Sheets("Dokumente").Range("C2"). _
Value
If Dir(Dokumente)  "" Then
Set AppWD = CreateObject("Word.Application") 'Word als Object  _
starten
If Not AppWD Is Nothing Then
End If
AppWD.Visible = True
Set AppDoc = AppWD.documents.Open(Dokumente)
If Not AppDoc Is Nothing Then
End If
With AppDoc.Range.Find
.Text = "test"
.MatchCase = True
.Replacement.Highlight = True
.Replacement.Text = ActiveWorkbook.Sheets("Eingabefenster"). _
Range("B5").Value
.Execute Replace:=wdReplaceAll
End With
Else
Dim strText As String, Wsh As Worksheet
Workbooks.Open (Dokumente)
strText = "Ersatz"
For Each Wsh In ActiveWorkbook.Worksheets
Wsh.UsedRange.Replace "test", strText, xlPart
End If
End If
End If
End If
Next b
End With
Next I
Next x
End Sub
Leider klappt es immer noch nicht.... an der Fehlermeldung hat sich auch nichts verändert.
Anzeige
AW: Fehler bei IF Schleifen
07.04.2020 16:20:07
Daniel
Naja jetzt musst du halt mal selber suchen.
Du weißt ja, worauf es ankommt.
Saubere Einrückungen helfen.
Lösche die unnötigen If-Blöcke (Also die, bei denen das End If direkt nach dem If kommt, ohne dass es irgendeine andere Anweisung gibt).
Gruß Daniel
AW: Fehler bei IF Schleifen
07.04.2020 17:03:28
Debugger
Hallo Daniel,
danke für deine Mühen.
Leider nichts gefunden....
Ich habe das ganze nun anders gelöst:
Habe das "Sub" "entschärft" und jeweils ein Call mit Programm eingefügt....
Damit funktioniert es nun.
Sub DokumenteAnlegen()
Dim pre, Projekt As String
pre = ActiveWorkbook.Sheets("Eingabefenster").Cells(7, 2)
Projekt = ActiveWorkbook.Sheets("Eingabefenster").Range("B5").Value
Dim x As Integer
Dim m As Integer
Dim I As Integer
Dim a As Integer
Dim b As Integer
Dim Dokumente As Variant
Dim DokumenteSource As Variant
m = Sheets("Dokumente").Cells(1, 1).End(xlToRight).Column
x = 1
For x = 1 To m
I = Sheets("Dokumente").Cells(1, x).End(xlUp).Row
Dokumente = (Sheets("Dokumente").Cells(2, x).Value)
For I = 1 To x
With Worksheets("Quelle")
a = .Cells(1, x).CurrentRegion.Rows.Count
For b = 1 To a
DokumenteSource = (Sheets("Quelle").Cells(b, x))
Dokumente = (Sheets("Dokumente").Cells(b + 1, x))
If Dokumente  "" Then
If (Dir(Sheets("Dokumente").Cells(1, x).Value)) = "" Then
If DokumenteSource  "" Then
FileCopy DokumenteSource, Dokumente
If Right(Dokumente, 5) = ".docx" Then
Call WordDokumentöffnen(Dokumente)
Else
Call ExcelDokumentöffnen(Dokumente)
End If
End If
End If
End If
Next b
End With
Next I
Next x
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige