Hier die Tabelle:
https://www.herber.de/bbs/user/12200.xls
Bitte um Hilfe
mfG
Andreas Grammel
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
If Target.Column <> 2 And Target.Column <> 3 Then Exit Sub
If Target.Row = 1 Then Exit Sub
If Target.Column = 2 Then
Cells(Target.Row, 4).Value = _
Cells(Target.Row, 4).Value + Cells(Target.Row, 2).Value
Else
Cells(Target.Row, 4).Value = _
Cells(Target.Row, 4).Value - Cells(Target.Row, 3).Value
End If
Cells(Target.Row, Target.Column).ClearContents
ERRORHANDLER:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
On Error GoTo fixit
Application.EnableEvents = False
If Target.Column = 2 Then
Target.Offset(0, 2) = Target.Offset(0, 2) + Target
Target = ""
ElseIf Target.Column = 3 Then
Target.Offset(0, 1) = Target.Offset(0, 1) - Target
Target = ""
End If
fixit:
Application.EnableEvents = True
End Sub