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
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
Kommentieren
Teilen
Auf Facebook teilen
Auf X (Twitter) teilen
Auf Reddit teilen
Auf Linkedin teilenBitte 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: 29.04.2025 um 18: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
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
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
Hallo,
Gruß
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
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 ?
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
Datei > Optionen > Sicherheitscenter > Einstellungen für das Sicherheitscenter > Einstellungen für Makros > "Alle Makros aktivieren ....", anhaken
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:
Die Zeile 4 und 15 müssen angepasst werden.
Vorteil ist, dass es dann auf allen Tabellen in der Arbeitsmappe funktioniert.
Gruß
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ß
1
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
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
