AW: Summanden und Summe in der gleichen Zell
07.10.2021 08:46:29
UweD
Hallo
- Rechtsclick auf den Tabellenblattreiter
- Code anzeigen
- Code rechts reinkopieren
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Dim RNG As Range, Z As Variant, Altwert, Neuwert
Const APPNAME = "Worksheet_Change"
Set RNG = Range("A1:A10") 'nur in diesem Bereich soll das geschehen
If Not Intersect(RNG, Target) Is Nothing Then
If Target.Count = 1 Then 'nur Einzelbearbeitung möglich
'Nur Zahlen erlaubt
If IsNumeric(Target) And Target "" Then
Neuwert = Target.Value
With Application
'vorherigen Wert ermitteln
.EnableEvents = False
.Undo
Altwert = Target.Value
'addieren
Target.Value = Altwert + Neuwert
.EnableEvents = True
End With
Else
MsgBox "Nur Zahlen erlaubt"
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
Exit Sub
End If
Else
MsgBox "Zellen nur einzeln bearbeitet"
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
End If
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub
- Bereich ggf. abändern
LG UweD