Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
OnChange1 Target, .Row, .Column, .Value
OnChange2 Target, .Row, .Column, .Value
End With
Application.EnableEvents = True
End Sub
Private Function OnChange1(Target As Range, R&, C&, V)
Dim NichtLeer As Boolean, Wert#
On Error Resume Next
Select Case R
Case Is > 33, Is < 4
Exit Function
End Select
Select Case C
Case Is > 7, Is < 4
Exit Function
Case 4: If V = "x" Then Wert = 3
Case Else: If V = "x" Then Wert = 1
End Select
If V <> "" Then
Range(Cells(R, 4), Cells(R, 7)).ClearContents
Target.Value = "x"
End If
If Wert <> 0 Then
Cells(6 + R, 3) = Wert
Else
If Cells(R, 8).End(xlToLeft).Column < 4 Then
Cells(6 + R, 3) = ""
End If
End If
End Function
Private Function OnChange2(Target As Range, R&, C&, V)
Dim rng As Range, sumCell As Range
On Error Resume Next
Set sumCell = Cells(R, 11)
If R > 33 Or V = "" Then
sumCell = ""
Exit Function
End If
Select Case C
Case Is > 8, Is < 4: Exit Function
End Select
Set rng = Range(Cells(R, 4), Cells(R, 8))
rng.ClearContents
Target.Value = "x"
sumCell = (8 - C) * Cells(R, 3)
End Function