AW: Es geht DOCH !
16.12.2022 12:45:13
onur
Private Sub CommandButton1_Click()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlManual
Cells.FormatConditions.Delete
Dim z, lz
lz = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For z = 2 To lz
If Cells(z, 5) Cells(z - 1, 5) And Cells(z, 1) "" Then
Cells(z, 19) = Cells(z - 1, 19) + 1
Else
Cells(z, 19) = Cells(z - 1, 19)
End If
Next z
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Call bedform
End Sub
Sub bedform()
Dim lz
Cells.FormatConditions.Delete
lz = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
With Range("A2:S" & lz)
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ISTGERADE(ZS19)"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = 0
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = True
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ISTUNGERADE(ZS19)"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = 0
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = True
End With
End Sub