Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Columns("I:K"), Target) Is Nothing Then Exit Sub
If Target.Row < 19 Or Target.Row > 803 Then Exit Sub
Dim nbf As Variant
Application.EnableEvents = False
nbf = Target.NumberFormat
Target.NumberFormat = "General"
Select Case Nachkomma(Target)
Case 0
Target.Offset(, 14).Value = 7
Case 1
Target.Offset(, 14).Value = 5
Case 2
Target.Offset(, 14).Value = 3
Case 3
Target.Offset(, 14).Value = 2
Case Else
End Select
Target.NumberFormat = nbf
Application.EnableEvents = True
End Sub
Private Function Nachkomma(Zelle As Range) As Integer
Dim intAb As Integer, intLen As Integer
intAb = InStr(1, Zelle.Text, Application.DecimalSeparator)
If intAb = 0 Then
Nachkomma = 0
Else
intLen = Len(Zelle.Text)
Nachkomma = intLen - intAb
End If
End Function