|
Ich hab's jetzt schon so oft probiert und kriegs ned hin, es tut sich einfach gar nichts. Nicht mal ein Fehler oder sonst was... Ich weiß nicht wie ich das noch hinzufügen kann?!
Hier hab ich mal rumprobiert, geht aber gar nicht: (fett gedruckt ist das, was ich eingefügt habe)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C&, NichtLeer As Boolean, R&, Wert#, V
Dim rng As Range, sumCell As Range
Application.EnableEvents = False
On Error GoTo ExitSub
With Target
R = .Row
C = .Column
V = .Value
End With
Select Case R
Case Is > 15, Is < 5
Application.EnableEvents = True
Exit Sub
End Select
Select Case C
Case Is > 7, Is < 4
Application.EnableEvents = True
Exit Sub
Case 4: If V = "x" Then Wert = 3
Case Else: If V = "x" Then Wert = 1
End Select
If V <> "" Then 'neu
Range(Cells(R, 4), Cells(R, 7)).ClearContents 'neu
Target = "x" 'neu
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
Select Case R
Case Is > 33, Is < 4
Application.EnableEvents = True
Exit Sub
Set rng = Range(Cells(R, 4), Cells(R, 8))
rng.ClearContents
sumCell = (8 - C) * Cells(R, 3) 'Summe
End Select
ExitSub:
Application.EnableEvents = True
End Sub
|