Sub läuft endlos

Hallo zusammen,
die zweite Parameter-Prüfung innerhalb der folgenden Sub-Prozedur läuft bei Ausführung in eine Endlosschleife, wobei ich nicht erkennen kann woran es liegt.
Die erste Parameter-Prüfung läuft ohne Probleme durch, wobei beide Prüfungen logisch identisch aufgebaut sind...

Sub Parameter_berechnen()
'Überschreibt den Inhalt aus Tabellenblatt "Bestandsliste" in Tabellenblatt "Kopie  _
Bestandsliste"
Sheets("Bestandsliste").UsedRange.Copy
Sheets("Kopie Bestandsliste").Select
Sheets("Kopie Bestandsliste").Cells(1, 1).Select
Sheets("Kopie Bestandsliste").Paste
Sheets("Kopie Bestandsliste").Cells(1, 1).Select
' Finde die letzte Zeile von "Kopie Bestandsliste"
Sheets("Kopie Bestandsliste").Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
'Parameterprüfung 1:
If Worksheets("Rollout-Cockpit").Range("I85") = "ja" Then
' Schleifenabfrage für jede Zeile in "Kopie Bestandsliste"
With Worksheets("Kopie Bestandsliste")
For p1a = 3 To FinalRow
If .Range("H" & p1a) = "2017" Then
If .Range("P" & p1a) = "FG1" And Worksheets("Rollout-Cockpit").Range("I13") = "ja"   _
_
_
Or .Range("P" & p1a) = "FG2" And Worksheets("Rollout-Cockpit").Range("I16") = "ja" Or .Range("P" _
_
& p1a) = "FG3" And Worksheets("Rollout-Cockpit").Range("I19") = "ja" Or .Range("P" & p1a) = " _
FG4" And Worksheets("Rollout-Cockpit").Range("I22") = "ja" Or .Range("P" & p1a) = "FG5" And Worksheets("Rollout-Cockpit").Range("I25") = "ja" Or .Range("P" & p1a) = "FG6" And Worksheets("Rollout-Cockpit").Range("I28") = "ja" Or .Range("P" & p1a) = "FG7" And Worksheets("Rollout-Cockpit").Range("I31") = "ja" Or .Range("P" & p1a) = "FG8" And Worksheets("Rollout-Cockpit").Range("I34") = "ja" Or .Range("P" & p1a) = "FG9" And Worksheets("Rollout-Cockpit").Range("I37") = "ja" Then
Anschlussobjektnummer = .Range("A" & p1a).Value
For p1b = 3 To FinalRow
If .Range("A" & p1b) = Anschlussobjektnummer And .Range("H" & p1b) > "2017" And .  _
_
_
Range("R" & p1b) = "FG16" Then
.Range("H" & p1b) = "2017"
.Range("H" & p1b).Interior.ColorIndex = 6
End If
Next p1b
End If
End If
Next p1a
End With
End If
'Parameterprüfung 2:
If Worksheets("Rollout-Cockpit").Range("I86") = "ja" Then
' Schleifenabfrage für jede Zeile in "Kopie Bestandsliste"
With Worksheets("Kopie Bestandsliste")
For p2a = 3 To FinalRow
If .Range("H" & p2a) = "2017" And .Range("R" & p2a) = "FG12" And Worksheets("Rollout- _
Cockpit").Range("I47") = "ja" Or .Range("R" & p2a) = "FG13" And Worksheets("Rollout-Cockpit").  _
_
Range("I50") = "ja" Or .Range("R" & p2a) = "FG14" And Worksheets("Rollout-Cockpit").Range("I53") _
= "ja" Or .Range("R" & p2a) = "FG15" And Worksheets("Rollout-Cockpit").Range("I56") = "ja" Then
Anschlussobjektnummer = .Range("A" & p2a).Value
For p2b = 3 To FinalRow
If .Range("A" & p2b) = Anschlussobjektnummer And .Range("H" & p2b) > "2017" And .  _
_
_
Range("P" & p2b) = "FG6" Or .Range("P" & p2b) = "FG7" Or .Range("P" & p2b) = "FG8" Or .Range("P" _
_
& p2b) = "FG9" Then
.Range("H" & p2b) = "2017"
.Range("H" & p2b).Interior.ColorIndex = 6
End If
Next p2b
End If
Next p2a
End With
End If
Sheets("Rollout-Cockpit").Select
End Sub

Erkennt jemand den Fehler?
Beste Grüße,
LekkoFunny

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Danke für den Hinweis, allerdings habe ich die if-Schleife extra wegen der Endlosschleife dahingehend angepasst - nachdem ich diese gerade wieder zurück gebaut habe, bleibt weiterhin die Endlosschleife (bzw. extrem lange Berechnungszeit, die ich nach 15min abgebrochen habe).
Ich vermute, dass das Problem in der inneren for-Schleife liegt. Hier soll mit "2017" überschreiben werden, wenn mehrere Bedingungen zutreffen (gleiche Anschlussobjektnummer + "H" größer 2017 + "P" entweder FG6 oder FG7 oder FG8 oder FG9).
Kann es sein, dass die Prüfung nicht korrekt aufgebaut ist. Denn er ändert auch zB. Zeilen, die nicht diese Anschlussobjektnummer besitzen, jedoch "H" größer 2017 und bspw. "P" gleich FP9 sind.
Ich denke, dass die "or"-Bedingungen auch greifen, wenn zuvor die Bedingungen nicht wahr sind, oder?

For p2b = 3 To FinalRow If .Range("A" & p2b) = Anschlussobjektnummer And .Range("H" & p2b) > "2017" Then Select Case .Range("P" & p2b) Case "FG6", "FG7", "FG8", "FG9" .Range("H" & p2b) = "2017" .Range("H" & p2b).Interior.ColorIndex = 6 End Select End If Next p2b

For p2a = 3 To FinalRow If .Range("H" & p2a) = "2017" And .Range("R" & p2a) = "FG12" And Worksheets("Rollout- _ Cockpit").Range("I47") = "ja" _ Or .Range("R" & p2a) = "FG13" And Worksheets("Rollout-Cockpit").Range("I50") = "ja" _ Or .Range("R" & p2a) = "FG14" And Worksheets("Rollout-Cockpit").Range("I53") = "ja" _ Or .Range("R" & p2a) = "FG15" And Worksheets("Rollout-Cockpit").Range("I56") = "ja" _ Then

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread