Zellwert wird nach dem addieren auf '0' gesetzt

Computer: Software & Programmierung Visual Basic
#1

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
#2

Hallo, Skaletti.

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

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.

VG
Carsten

#3

Hallo Skaletti,

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

Gruß
Reinhard

#4

Hallo Carsten, Hallo Reinhard,
funzt beides.
Danke für die Hilfe.
Gruß Skaletti!