Hallo,
Aus den Zellen in der Spalte „J“ wird der eingegebene Wert in andere
Zellen addiert.Bei der nächsten aktivierung der Zelle wird der
vorhandene Wert gelöscht um einen neuen Wert eingeben zu können,
der dann wieder in die gleiche Zelle addiert wird. Beim löschen
des Wertes wird aber auch der Wert in der addierten Zelle wieder
abgezogen. Kann man das verhindern???
Vielen Dank für jede Hilfe im voraus.
Gruß Skaletti!
Hier mein Code:
Option Explicit
Private Sub Worksheet\_SelectionChange(ByVal Target As Range)
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Union(Range("J2:J35"), Range("J37:J70"), Range("J72:J105"), Range("J107:J140"))
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
Application.EnableEvents = False
RaZelle.Offset(2, 10) = RaZelle.Offset(2, 10) + RaZelle
RaZelle = ""
Application.EnableEvents = True
End If
Next RaZelle
Set RaBereich = Nothing
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Union(Range(„J2:J35“), Range(„J37:J70“),
Range(„J72:J105“), Range(„J107:J140“))
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
Application.EnableEvents = False
RaZelle.Offset(2, 10) = RaZelle.Offset(2, 10) +
RaZelle
RaZelle = „“
Application.EnableEvents = True
End If
Next RaZelle
Set RaBereich = Nothing
End Sub
Ich denke, dass es besser ist, den Code in das „Worksheet_Change“-Ereignis zu schreiben. So, wie es jetzt ist, wird der Code ja bei jeder Veränderung der Markierung aufgerufen.
Vielleicht ungefähr so:
Private Sub Worksheet\_Change(ByVal Target As Range)
Dim NumErr As Single
On Error GoTo ErrHandler
Select Case Target.Column
Case 10 'Spalte J
Application.EnableEvents = False
If IsEmpty(Target) = False Then
NumErr = Target \* 1
Cells(Target.Row, Summenspalte) = Cells(Target.Row, Summenspalte) + Target
Target.ClearContents
End If
End Select
Ende:
Application.EnableEvents = True
Exit Sub
ErrHandler:
Resume Ende
End Sub
Dies ist nur prinzipiell gemeint und mit „Offset“ und „Union“ kenne ich mich nicht aus.
Beim löschen
des Wertes wird aber auch der Wert in der addierten Zelle
wieder abgezogen.
bei mir wird da nix abgezogen. Es ist auch im Code nichts entsprechendes ersichtlich.
Reine Geschmakcssache, ich würde das ggfs. so schreiben:
Private Sub Worksheet\_SelectionChange(ByVal Target As Range)
Dim rngBereich As Range, rngZelle As Range
Set rngBereich = Union(Range("J2:J35"), Range("J37:J70"), Range("J72:J105"), Range("J107:J140"))
Set Target = Intersect(Target, rngBereich)
If Target Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rngZelle In Target
rngZelle.Offset(2, 10) = rngZelle.Offset(2, 10) + rngZelle
rngZelle = ""
Next rngZelle
Application.EnableEvents = True
Set rngBereich = Nothing
End Sub