chatzestrecker
Aug 04, 2014
view1737
view8
0
Goto Top

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

GermansolvedQuestionMicrosoft OfficeMicrosoft
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
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 245471

Url: https://administrator.de/contentid/245471

Printed on: April 23, 2024 at 21:04 o'clock

8 Comments
Latest comment
Goto Top
Member: bastla
bastla Aug 04, 2014 at 06:47:55 (UTC)
Goto Top
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
Member: chatzestrecker
chatzestrecker Aug 04, 2014 at 09:03:08 (UTC)
Goto Top
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
Member: colinardo
colinardo Aug 04, 2014 updated at 09:39:41 (UTC)
Goto Top
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
Member: opalka
opalka Aug 04, 2014 at 09:10:25 (UTC)
Goto Top
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ß
Member: chatzestrecker
chatzestrecker Aug 04, 2014 at 09:40:45 (UTC)
Goto Top
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
Member: colinardo
Solution colinardo Aug 04, 2014 updated at 13:52:39 (UTC)
Goto Top
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
Member: opalka
opalka Aug 04, 2014 updated at 10:15:37 (UTC)
Goto Top
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ß
heart1
Member: chatzestrecker
chatzestrecker Aug 04, 2014 at 11:03:24 (UTC)
Goto Top
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
GermansolvedQuestionMicrosoft OfficeMicrosoft
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments