Exit aus Fallprüfung
18.01.2022 10:41:34
LUHU
ich habe einen Select Case Fall und folgenden Code.
Die Frage lautet: Wie schaffe ich in dem Case 2 Is > val_max 'grösser Toleranz jedes mal die Prüfung einzubauen ob AB7 nun im Toleranzbereich ist (also Case 1) ist bzw. die Zelle in AB7 grün ist und dann automatisch die nächste Zeile kontrolliert wird.
Mir fehlt wie gesagt, die Möglichkeit des vorzeitigen Exits von Case 2 Is > val_max 'grösser Toleranz
Um jede Hilfe bin ich dankbar!
Sub Datenprüfung()
Dim rng As Range
Dim val As Range
Dim val_min As Long, val_max As Long
' Spalte 28 entspricht Zelle AB
Dim z As Long
z = Cells(Rows.Count, 28).End(xlUp).Row
For z = 7 To z
Cells(z, 28).FormulaR1C1 = "=Sum(RC20, RC34, RC36, RC38, RC40, RC42, RC44, RC46, RC48, RC50, RC52, RC54, RC56, RC58)"
Next
z = Cells(Rows.Count, 27).End(xlUp).Row
Set rng = Columns("AB").SpecialCells(xlCellTypeFormulas)
rng.Interior.ColorIndex = xlNone
For Each val In rng
val_min = Cells(val.Row, "Y") - Cells(val.Row, "V")
val_max = Cells(val.Row, "Y") + Cells(val.Row, "V")
Select Case val
Case val_min To val_max 'in Toleranz
val.Interior.Color = vbGreen
Case Is > val_max 'grösser Toleranz
BF_alt = Cells(val.Row, "BF")
'in Zelle BF7 springen und dort so lange den Wert in Zelle BF7 mit V7 subtrahieren, bis der Wert in BF7 entweder 0 oder der Wert in Zelle AB7 in der Range von Y7 +- V7 ist.
Do
Cells(val.Row, "BF") = Cells(val.Row, "BF") - Cells(val.Row, "V")
Loop Until Cells(val.Row, "BF") = val_min And val 'Wert wiederherstellen
wenn Zelle BF7 null ist
' in Zelle BD7 springen und dort das gleiche machen wie in Zelle BF7.
'Wert in Zelle BD7 mit V7 subtrahieren, bis der Wert in BD7 entweder 0 oder der Wert in Zelle AB7 in der Range von Y7 +- V7 ist
'GIBT ES HIER DIE MÖGLICHKEIT EINES EXITS DES CASES: Falls nach der Subtration BF7 - V7 dann AB7 in Toleranzbereich, dann prüfe nächsten Case,
ansonsten gehe zu BD7 und mache das gleiche .
Folgender Code funktioniert dabei nicht!
If Cells(val.Row, "AB") = vbGreen Then
Next val
End If
End If
BD_alt = Cells(val.Row, "BD")
Do
Cells(val.Row, "BD") = Cells(val.Row, "BD") - Cells(val.Row, "V")
Loop Until Cells(val.Row, "BD") val_min And val 'wenn Zelle BF7 null ist
'dann in Zelle BD7 springen und dort das gleiche machen wie in Zelle BF7.
'Wert in Zelle BD7 mit V7 subtrahieren, bis der Wert in BD7 entweder 0 oder der Wert in Zelle AB7 in der Range von X7 +- U7 ist.
'Falls nach der Subtraktion BF7 - V7 dann AB7 in Toleranzbereich, dann prüfe nächsten Case, ansonsten gehe zu BD7 und mache das gleiche .
End If
Case Is = val_min And val