Excel das gleiches Makro zur addition in einem Feld, in mehreren Spalten benützen

Hallo Zusammen

Ich habe folgendes Makro gefunden um im gleichen Feld addieren zu können.
Nun möchte ich auch, dass das gleiche Makro in den Spalten C-F ausgeführt wird.

Was muss ich machen?
Grüsse
chatzestrecker

Public letzterWert
Public aendern As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, ActiveSheet.Range("A1:B29")) Is Nothing Then Exit Sub
If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
If aendern = False Then Exit Sub
Application.EnableEvents = False
Target = Target + letzterWert
letzterWert = 0
aendern = False
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.Intersect(Target, ActiveSheet.Range("B1:B29")) Is Nothing Then Exit Sub
If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
letzterWert = Target.Value
aendern = True
End Sub

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 245471

Url: https://administrator.de/forum/excel-das-gleiches-makro-zur-addition-in-einem-feld-in-mehreren-spalten-benuetzen-245471.html

Ausgedruckt am: 05.04.2025 um 17:04 Uhr

8 Kommentare

Neuester Kommentar

Hallo chatzestrecker und willkommen im Forum!

Die Zellen, für die eine Verarbeitung erfolgen soll, sind derzeit mit "A1:B29" bzw "B1:B29" festgelegt - passe daher diese Werte an ...

Grüße
bastla

Herzlichen dank für die schnelle Antwort.

Leider habe ich nun das Problem, dass nach dem abspeichern, der Code gar nicht mehr funktioniert.
Anfangs ging der Code in der Spalte B

Ich habe noch ein paar Änderungen im Blatt gemacht. Dies hat sicher ein Zusammenhang.

In der Spalte A sind Datum hinterlegt hier muss nichts gerechnet werden.
In Der Zeile 1 von Spalte A-H sind die Titel hinterlegt.

Gerechnet werden muss in allen Zellen von B2 - H29 ( jeweils eine einfache Addition)

Was ich genau ändern muss ist mir leider nicht klar ( bin in dieser Hinsicht ein Neuling)

Kann mir jemand den genauen Code posten?

Danke vielmals

Grüsse
Chatzestrecker

Public letzterWert
Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, ActiveSheet.Range("B2:H29")) Is Nothing Then Exit Sub  
    Application.EnableEvents = False
    If Not IsNumeric(Target.Value) Or IsEmpty(Target.Value) Then
        letzterWert = 0
    Else
        Target = Target + letzterWert
        letzterWert = 0
    End If
    Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Application.Intersect(Target, ActiveSheet.Range("B2:H29")) Is Nothing Then Exit Sub  
    If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
    letzterWert = Target.Value
End Sub

Grüße Uwe

Hallo,

Public letzterWert
Public aendern As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
  If Application.Intersect(Target, ActiveSheet.Range("B2:H29")) Is Nothing Then Exit Sub  
  If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
  If aendern = False Then Exit Sub
  Application.EnableEvents = False
  Target = Target + letzterWert
  letzterWert = 0
  aendern = False
  Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Application.Intersect(Target, ActiveSheet.Range("B2:H29")) Is Nothing Then Exit Sub  
  If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
  letzterWert = Target.Value
  aendern = True
End Sub 

Gruß

Danke für die Antwort

Das habe ich schon versucht (bevor ich geschrieben habe), trotzdem funktioniert es nicht.
Es wird kein Wert in den Zellen addiert.

Ich dachte , das hier eine andere Formel zur Geltung kommt.
Ich habe nun auch den Code gegenkontrolliert. Fehler habe ich keinen entdeckt.

Public letzterWert
Public aendern As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, ActiveSheet.Range("B2:H29")) Is Nothing Then Exit Sub
If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
If aendern = False Then Exit Sub
Application.EnableEvents = False
Target = Target + letzterWert
letzterWert = 0
aendern = False
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.Intersect(Target, ActiveSheet.Range("B2:H29")) Is Nothing Then Exit Sub
If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
letzterWert = Target.Value
aendern = True
End Sub

Hast du Makros überhaupt schon im Sicherheitscenter von Excel aktiviert ?

Datei > Optionen > Sicherheitscenter > Einstellungen für das Sicherheitscenter > Einstellungen für Makros > "Alle Makros aktivieren ....", anhaken

Und wurde der Code im richtigen Abschnitt des VBA-Editors eingefügt, nämlich im Abschnitt des richtigen Worksheets ?
Hier noch das funktionsfähige Demosheet dazu, damit sollte alles klar sein.

Grüße Uwe

Das ganze funktioniert nur, wenn der Code im VBAProjekt in jede Tabelle kopiert wird. Steht der Code in der Arbeitsmappe, dann muss er wie folgt geändert werden:

Public letzterWert
Public aendern As Boolean

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Application.Intersect(Target, ActiveSheet.Range("B2:H29")) Is Nothing Then Exit Sub  
  If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
  If aendern = False Then Exit Sub
  Application.EnableEvents = False
  Target = Target + letzterWert
  letzterWert = 0
  aendern = False
  Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  If Application.Intersect(Target, ActiveSheet.Range("B2:H29")) Is Nothing Then Exit Sub  
  If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
  letzterWert = Target.Value
  aendern = True
End Sub 

Die Zeile 4 und 15 müssen angepasst werden.

Vorteil ist, dass es dann auf allen Tabellen in der Arbeitsmappe funktioniert.

Gruß

Danke für diesen Input.

So wie ich gesehen habe liegt das Problem an der Aktivierung.

Im Moment sind bei mir nur Makros mit digitaler Zertifizierung zugelassen.
Muss wohl die Freigabe von unserer IT kriegen.

Herzlichen dank an Euch beide

gelöst Frage Microsoft Microsoft Office

Heiß diskutiert