Office: "Next" ohne "For

tino2010 · 7. Januar 2017

Hallo,

ich nutze nachfolgenden Code, um Zellwerte von einem Blatt in ein anderes zu übertragen. Den Inhalt des Weggeschriebenen kopiere ich und lasse es auf einem anderen Blatt einfügen.
Wenn ich den Code durchlaufen lasse, meldet er mir ein "Next" ohne For und markiert mir das rot eingefärbte Next im Debugger. Allerdings ist da meiner Meinung nach ein For - ich habe es grün eingefärbt.

LG und vielen Dank für eure Hilfe.

Code:

Sub HSA_berechnen()
Dim i As Long
Dim Zelle As Range
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim wksX As Worksheet
Dim wksW As Worksheet
Dim ws As Worksheet
Dim NeuerTabellenName As String
Set wksQ = Worksheets("NB9_2")
Set wksH = Worksheets("HSA")
Set wksAH = Worksheets("Abschluss_HSA")
Set wksW = Worksheets("WPU-1")
'--Application.ScreenUpdating = False
'--Bereits vorhandene Berechnungen (HSA) von Schuelern in Historie loeschen
For Each Worksheet In ThisWorkbook.Worksheets
Worksheet.Unprotect "bgs,.zeugnis"
Next
i = Worksheets.Count
For x = 40 To i Step 1
Worksheets(x).Range("O1:Y29").Clear '--Vorherige HSA-Berechnung loeschen
Next x
'--Blattschutz aufheben um Zellen aendern zu koennen
If wksAH.ProtectContents = True Then
wksAH.Unprotect "bgs,.zeugnis"
End If
wksH.Activate
With wksH
For i = 6 To wksQ.Cells(Rows.Count, 1).End(xlUp).Row '--eintragen in Blatt "HSA"
'--Berechnung fuer Schueler ueberspringen, wenn keine HSA-Pruefung abgelegt (Trigger: keine Deutsch- und Mathe-Pruefungsnote auf Blatt wksX)
If wksAH.Cells(i, "D").Value = "" And wksAH.Cells(i, "F").Value = "" Then
wksAH.Cells(i, "P").Value = "Keine HSA-Pruefung"
GoTo Auslassen
End If
'--Eintraege in HSA loeschen, falls Reste drin stehen geblieben sind
.Range("B4:C20").ClearContents '-- Eintraege in HSA loeschen
.Range("E4:E6").ClearContents '-- Eintraege in HSA loeschen
.Range("E21").ClearContents '-- Eintraege in HSA loeschen
.Range("C29").ClearContents '-- Eintraege in HSA loeschen
'--Name in HSA-Berechnung
.Range("C2") = Worksheets("Personendaten").Cells(i, "B") '--Vorname
.Range("F2") = Worksheets("Personendaten").Cells(i, "A") '--Name
'--Noten in HSA-Berechnung
.Range("C4") = wksQ.Cells(i, "O") '--Deutsch
.Range("B4") = wksQ.Cells(i, "P") '--Deutsch-Kurs aus Spalte P
.Range("C6") = wksQ.Cells(i, "R") '--Mathematik
.Range("B6") = wksQ.Cells(i, "S") '--Mathe-Kurs aus Spalte S
.Range("C5") = wksQ.Cells(i, "U") '--Englisch
.Range("B5") = wksQ.Cells(i, "V") '--Englisch-Kurs aus Spalte V
.Range("C14") = wksQ.Cells(i, "X") '--Physik
.Range("B14") = wksQ.Cells(i, "Y") '--Physik-Kurs aus Spalte Y
.Range("C13") = wksQ.Cells(i, "AA") '--Chemie
.Range("B13") = wksQ.Cells(i, "AB") '--Chemie-Kurs aus Spalte AB
'--Wenn WPU-1 = Arbeitslehre, dann H-Note fr AL nehmen
If wksQ.Cells(i, "BB") = "AL" Then
.Range("C18") = wksQ.Cells(i, "BA")
Else
.Range("C18") = wksQ.Cells(i, "AZ") '-- sonst die IGS-Note von F / L nehmen
End If
If wksQ.Cells(i, "BB") = "F (A)" Or wksQ.Cells(i, "BB") = "L (A)" Then '--Franzsisch / Latein-Kurs bertragen
.Range("B18") = "A"
ElseIf wksQ.Cells(i, "BB") = "F (B)" Then
.Range("B18") = "B"
Else
.Range("B18") = "" '-- bei AL kein Kurs eintragen, da H-Note
.Range("C12") = wksQ.Cells(i, "AE") '--Biologie aus Spalte AE
.Range("C9") = wksQ.Cells(i, "AG") '--Geschichte aus Spalte AG
.Range("C7") = wksQ.Cells(i, "AI") '--Erdkunde aus Spalte Ai
.Range("C8") = wksQ.Cells(i, "AK") '--PoWi aus Spalte AK
.Range("C10") = wksQ.Cells(i, "AM") '--Reli/Ethik aus Spalte AM
If wksQ.Cells(i, "AY") "---" Then '-- Wenn Syr.-Orth. Religion-Note vorhanden dann uebernehmen
.Range("C20") = wksQ.Cells(i, "AY")
Else: .Range("C20") = " "
End If
'--Musik wird in Klasse 9 nicht unterrichtet, also kommt es nicht mit in die Berechnung fuer HSA wird aber aus 8_2 geholt
If wksQ.Cells(i, "AQ") = "1" Then
.Range("C16") = "e"
ElseIf wksQ.Cells(i, "AQ") = "2" Then
.Range("C16") = "z"
ElseIf wksQ.Cells(i, "AQ") = "3" Then
.Range("C16") = "d"
ElseIf wksQ.Cells(i, "AQ") = "4" Then
.Range("C16") = "v"
ElseIf wksQ.Cells(i, "AQ") = "5" Then
.Range("C16") = "f"
ElseIf wksQ.Cells(i, "AQ") = "6" Then
.Range("C16") = "s"
End If
.Range("C15") = wksQ.Cells(i, "AT") '--Kunst aus Spalte AT
.Range("C11") = wksQ.Cells(i, "AU") '--Sport aus Spalte AU
.Range("C19") = wksQ.Cells(i, "BE") '--WPU-II-Note aus Spalte Be
.Range("C17") = wksQ.Cells(i, "AP") '--BSO aus Spalte AP
.Range("E4") = wksAH.Cells(i, "D") '--Pruefungsnote Deutsch
.Range("E5") = wksAH.Cells(i, "H") '--Pruefungsnote Englisch
.Range("E6") = wksAH.Cells(i, "F") '--Pruefungsnote Mathe
.Range("E21") = wksAH.Cells(i, "J") '--Projektpruefung uebertragen
.Range("C29") = wksAH.Cells(i, "L") '--Abschlussbedingungen erfuellt?
'--Wenn nur ein HSA erreicht wird, dann muss Pruefungsnote Englisch herausgeloescht werden
If IsError(wksH.Cells(29, 6).Value) Then
wksAH.Cells(i, "P").Value = "Noten- bzw. Kursangaben unvollstaendig"
GoTo Weiter
ElseIf wksH.Cells(29, 6).Value = "Hauptschulabschluss" Then
wksH.Cells(5, 5).ClearContents '-- Pruefungsnote Englisch
End If
wksAH.Cells(i, "O").Value = .Range("H26").Value '--Gesamtnote uebertragen
wksAH.Cells(i, "P").Value = .Range("F29").Value '--Abschluss uebertragen
'--Blatt mit Schuelernamen suchen
NeuerTabellenName = wksQ.Cells(i, "B").Value & " " & wksQ.Cells(i, "A")
If SheetExist(NeuerTabellenName) Then
'--Blatt mit Eintragungen fuer HSA-Berechnung ans Ende kopieren
Range("A1:K29").Select
Selection.Copy
Sheets(NeuerTabellenName).Select
Range("O1").Select
ActiveSheet.Paste
End If
wksH.Activate
Weiter:
'--Inhalte der Berechnung loeschen
wksH.Range("B4:C20").ClearContents '-- Eintraege in HSA loeschen
wksH.Range("E4:E6").ClearContents '-- Eintraege in HSA loeschen
wksH.Range("E21").ClearContents '-- Eintraege in HSA loeschen
wksH.Range("C29").ClearContents '-- Eintraege in HSA loeschen
Auslassen:
Next
End With
wksAH.Activate
If wksAH.ProtectContents = False Then
wksAH.Protect userinterfaceonly:=True, Password:="bgs,.zeugnis", DrawingObjects:=True, _
Contents:=True, Scenarios:=True, AllowFormattingColumns:=True
End If
For Each Worksheet In ThisWorkbook.Worksheets
Worksheet.Protect "bgs,.zeugnis"
Next
Application.ScreenUpdating = True
Set wksQ = Nothing
Set wksH = Nothing
Set wksAH = Nothing
End Sub

'--Mithilfe einer Funktion ueberpruefen, ob es das Blatt bereits gibt
Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
Dim wks As Worksheet
On Error GoTo ERRORHANDLER
If Wb Is Nothing Then Set Wb = ThisWorkbook
For Each wks In Wb.Worksheets
If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
Next
ERRORHANDLER:
SheetExist = False
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

ebs17 · 8. Januar 2017

Eine fehlerhaftes If-Then-End If innerhalb der Schleife kann eine solche Meldung auch mal auslösen. Überprüfen.
Sowie Code sauber formatieren (einrücken). Der Smart Indenter ist da ein gutes Hilfsmittel zur Kontrolle über den Code.

tino2010 · 8. Januar 2017

Eine fehlerhaftes If-Then-End If innerhalb der Schleife kann eine solche Meldung auch mal auslösen.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Vielen Dank für diesen Hinweis. Ich hatte ein End-If vergessen ...

LG*mrcool

EarlFred · 8. Januar 2017

Hallo,

deklariere zuerst mal alle Variable. Setze Option Explicit.

Deine Laufvariable "Worksheet" ist ebenfalls nicht deklariert und den Namen finde ich wegen der Überschneidung mit dem gleichlautenden Klassennamen ungünstig.

Rücke jeden Block auf die gleiche Ebene ein, dann siehst Du, wo eine abschließende Zeile fehlt.

Spaghetticode mit den vielen "Goto Sprungmarke" ist ohnehin schwer nachvollziehbar.

Mal schnell neu formatiert und ein paar Kleinigkeiten geändert:
Code:

Option Explicit

Sub HSA_berechnen()
Dim i As Long
Dim Zelle As Range
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim wksX As Worksheet
Dim wksW As Worksheet
Dim ws As Worksheet
Dim NeuerTabellenName As String

Dim wksH As Worksheet, wksAH As Worksheet

Set wksQ = Worksheets("NB9_2")
Set wksH = Worksheets("HSA")
Set wksAH = Worksheets("Abschluss_HSA")
Set wksW = Worksheets("WPU-1")

For Each ws In ThisWorkbook.Worksheets
ws.Unprotect "bgs,.zeugnis"
Next ws

i = Worksheets.Count
For x = 40 To i Step 1
Worksheets(x).Range("O1:Y29").Clear '--Vorherige HSA-Berechnung loeschen
Next x

If wksAH.ProtectContents = True Then
wksAH.Unprotect "bgs,.zeugnis"
End If
wksH.Activate

With wksH
For i = 6 To wksQ.Cells(Rows.Count, 1).End(xlUp).Row '--eintragen in Blatt "HSA"
If wksAH.Cells(i, "D").Value = "" And wksAH.Cells(i, "F").Value = "" Then
wksAH.Cells(i, "P").Value = "Keine HSA-Pruefung"
GoTo Auslassen
End If

.Range("B4:C20").ClearContents '-- Eintraege in HSA loeschen
.Range("E4:E6").ClearContents '-- Eintraege in HSA loeschen
.Range("E21").ClearContents '-- Eintraege in HSA loeschen
.Range("C29").ClearContents '-- Eintraege in HSA loeschen
.Range("C2") = Worksheets("Personendaten").Cells(i, "B") '--Vorname
.Range("F2") = Worksheets("Personendaten").Cells(i, "A") '--Name
.Range("C4") = wksQ.Cells(i, "O") '--Deutsch
.Range("B4") = wksQ.Cells(i, "P") '--Deutsch-Kurs aus Spalte P
.Range("C6") = wksQ.Cells(i, "R") '--Mathematik
.Range("B6") = wksQ.Cells(i, "S") '--Mathe-Kurs aus Spalte S
.Range("C5") = wksQ.Cells(i, "U") '--Englisch
.Range("B5") = wksQ.Cells(i, "V") '--Englisch-Kurs aus Spalte V
.Range("C14") = wksQ.Cells(i, "X") '--Physik
.Range("B14") = wksQ.Cells(i, "Y") '--Physik-Kurs aus Spalte Y
.Range("C13") = wksQ.Cells(i, "AA") '--Chemie
.Range("B13") = wksQ.Cells(i, "AB") '--Chemie-Kurs aus Spalte AB

If wksQ.Cells(i, "BB") = "AL" Then
.Range("C18") = wksQ.Cells(i, "BA")
Else
.Range("C18") = wksQ.Cells(i, "AZ") '-- sonst die IGS-Note von F / L nehmen
End If

If wksQ.Cells(i, "BB") = "F (A)" Or wksQ.Cells(i, "BB") = "L (A)" Then '--Franzsisch / Latein-Kurs bertragen
.Range("B18") = "A"
ElseIf wksQ.Cells(i, "BB") = "F (B)" Then
.Range("B18") = "B"
Else
.Range("B18") = "" '-- bei AL kein Kurs eintragen, da H-Note
.Range("C12") = wksQ.Cells(i, "AE") '--Biologie aus Spalte AE
.Range("C9") = wksQ.Cells(i, "AG") '--Geschichte aus Spalte AG
.Range("C7") = wksQ.Cells(i, "AI") '--Erdkunde aus Spalte Ai
.Range("C8") = wksQ.Cells(i, "AK") '--PoWi aus Spalte AK
.Range("C10") = wksQ.Cells(i, "AM") '--Reli/Ethik aus Spalte AM

If wksQ.Cells(i, "AY") "---" Then '-- Wenn Syr.-Orth. Religion-Note vorhanden dann uebernehmen
.Range("C20") = wksQ.Cells(i, "AY")
Else
.Range("C20") = " "
End If

If wksQ.Cells(i, "AQ") = 1 Then 'Zahlen nicht als Text ansprechen
.Range("C16") = "e"
ElseIf wksQ.Cells(i, "AQ") = 2 Then
.Range("C16") = "z"
ElseIf wksQ.Cells(i, "AQ") = 3 Then
.Range("C16") = "d"
ElseIf wksQ.Cells(i, "AQ") = 4 Then
.Range("C16") = "v"
ElseIf wksQ.Cells(i, "AQ") = 5 Then
.Range("C16") = "f"
ElseIf wksQ.Cells(i, "AQ") = 6 Then
.Range("C16") = "s"
End If

.Range("C15") = wksQ.Cells(i, "AT") '--Kunst aus Spalte AT
.Range("C11") = wksQ.Cells(i, "AU") '--Sport aus Spalte AU
.Range("C19") = wksQ.Cells(i, "BE") '--WPU-II-Note aus Spalte Be
.Range("C17") = wksQ.Cells(i, "AP") '--BSO aus Spalte AP
.Range("E4") = wksAH.Cells(i, "D") '--Pruefungsnote Deutsch
.Range("E5") = wksAH.Cells(i, "H") '--Pruefungsnote Englisch
.Range("E6") = wksAH.Cells(i, "F") '--Pruefungsnote Mathe
.Range("E21") = wksAH.Cells(i, "J") '--Projektpruefung uebertragen
.Range("C29") = wksAH.Cells(i, "L") '--Abschlussbedingungen erfuellt?

If IsError(wksH.Cells(29, 6).Value) Then
wksAH.Cells(i, "P").Value = "Noten- bzw. Kursangaben unvollstaendig"
GoTo Weiter
ElseIf wksH.Cells(29, 6).Value = "Hauptschulabschluss" Then
wksH.Cells(5, 5).ClearContents '-- Pruefungsnote Englisch
End If

wksAH.Cells(i, "O").Value = .Range("H26").Value '--Gesamtnote uebertragen
wksAH.Cells(i, "P").Value = .Range("F29").Value '--Abschluss uebertragen

NeuerTabellenName = wksQ.Cells(i, "B").Value & " " & wksQ.Cells(i, "A")

If SheetExist(NeuerTabellenName) Then
Range("A1:K29").Select
Selection.Copy
Sheets(NeuerTabellenName).Select
Range("O1").Select
ActiveSheet.Paste
End If

wksH.Activate

Weiter:
wksH.Range("B4:C20").ClearContents '-- Eintraege in HSA loeschen
wksH.Range("E4:E6").ClearContents '-- Eintraege in HSA loeschen
wksH.Range("E21").ClearContents '-- Eintraege in HSA loeschen
wksH.Range("C29").ClearContents '-- Eintraege in HSA loeschen
Auslassen:

Next wksH
End With

wksAH.Activate
If wksAH.ProtectContents = False Then
wksAH.Protect userinterfaceonly:=True, Password:="bgs,.zeugnis", DrawingObjects:=True, _
Contents:=True, Scenarios:=True, AllowFormattingColumns:=True
End If

For Each Worksheet In ThisWorkbook.Worksheets
Worksheet.Protect "bgs,.zeugnis"
Next

Application.ScreenUpdating = True
Set wksQ = Nothing
Set wksH = Nothing
Set wksAH = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wo wird der rot markierte If-Block geschlossen?

Edit: Irgendwie hat's die Umlaute zerschossen...

Grüße
EarlFred

Office: "Next" ohne "For

"Next" ohne "For

"Next" ohne "For

"Next" ohne "For

"Next" ohne "For - Similar Threads - Next For

For Each Next läuft nur einmal durch

For Next Schleife

Access For next Schleife

For Next Schleife verzögern, Tastatureingabe abfragen

.Cells(Rows.Count, 1).End(xlUp).Row zählt nicht rauf in for next Schleife

For Next Schleife vorzeitig nächsten Schleifendurchgang

For-Next-Schleife für Textfeldübertragung