Office: Wenn sich der Wert in einer Zelle ändert, dann soll die Änderung kumulativ anzeigen

Hallo ich habe folgendes Problem:

Wenn sich in einer Zelle (E7) der Wert ändert, dann soll in der Zelle (G7) kumulativ die Änderung (+1) gezählt werden.
Das soll dann auch für alle anderen einzelnen Zelle (E8 bis E71) funktionieren, die Anderungen dann in (G8 bis G71).



Kann mir da jemand weiterhelfen ?? Ich hab da nicht so richtig Plan

Danke !!!

 

Hallo!

Werden die Werte in Spalte E manuell eingetragen, oder steckt da eine Formel dahinter? Wenn ja, welche?

 

Die werden von Hand eingetragen

 

Hallo!

Mach einen Rechtsklick auf den Tabellenreiter des Blatts, wähle "Code anzeigen" und kopiere diesen Code ins Codefenster:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E8:E71")) Is Nothing And Target.Count = 1 Then _
Target.Offset(0, 2) = Target.Offset(0, 2) + 1
End Sub

 

Danke funktioniert.

Was müsste geändert werden, wenn die Zahl per Formel eingetragen wird ??

=C7/60

 

Hat dafür jemand vielleicht eine Lösung ???

 

Hallo,

so einfach ist das nicht, denn das Worksheet_Change-Ereignis tritt nur ein, wenn der User eine Zelle durch Eingabe eines Wertes ändert.
Ändert sich der Zellwert nur deshalb, weil eine Zellformel ein anderes Ergebnis geliefert hat, tritt statt dessen das Worksheet_Calculate-Ereignis ein - nachdem die Änderung in der Zelle passiert ist. Da dieses Ereignis keinen Target-Parameter hat, weiß man nur, dass eine Neuberechnung des Arbeitsblattes stattgefunden hat - aber wo, das ist die große Preisfrage.
Um diese Preisfrage zu lösen, muss man sich zuerst einen Hilfsbereich reservieren, der die Zellwerte des Bereiches E8:E71 enthält, bevor eine solche Blattneuberechnung erfolgte. Im untenstehenden Makro habe ich dafür den Bereich "Z8:Z71" hergenommen. Falls dies bei Dir ein anderer Bereich sein muss/soll, müsstest Du die entsprechend (rot) gekennzeichnete Stelle im Makro ändern, aber nur die beiden Z durch einen neuen Spaltenbuchstaben (nicht jedoch die Zeilennummern!!)

Code:

Private Sub Worksheet_Calculate()
  'Dieses Ereignis tritt ein, nachdem das Arbeitsblatt neu berechnet wurde
  Dim rngIstNeuberechnet As Range
  Dim rngVergleichswerte As Range
  Dim rngZelle As Range, SpalteZ_Diff As Long
  '
  'Bereich der Zellen, die überprüft werden sollen, ob sich durch Berechnungen ihr Wert geändert hat:
  '(Im Bereich G8:G71 sind die Zähler enthalten, die mitzählen, wie oft eine solche Zelländerung erfolgte)
  Set rngIstNeuberechnet = Range("E8:E71")
  '
  'Bereich der Zellen, die die Werte aus E8:E71 bis vor der letzten Neuberechnung des Arbeitsblattes enthalten:
  Set rngVergleichswerte = Range("[COLOR=#ff0000][B]Z[/B][/COLOR]8:[COLOR=#ff0000][B]Z[/B][/COLOR]71")  '<--- eventuell anderen Bereich wählen!!
  '
  SpalteZ_Diff = rngVergleichswerte.Column - rngIstNeuberechnet.Column
  Application.EnableEvents = False
  For Each rngZelle In rngIstNeuberechnet.Cells
    With rngZelle
      If .HasFormula Then
        If .Value <> .Offset(0, SpalteZ_Diff) Then
          .Offset(0, SpalteZ_Diff) = .Value
          .Offset(0, 2) = .Offset(0, 2) + 1
        End If
      End If
    End With
  Next rngZelle
  Application.EnableEvents = True
  '
End Sub
'
Private Sub Worksheet_Change(ByVal Target As Range)
  'Dieses Ereignis tritt ein, nachdem der User im Target-Bereich neue Werte eingegeben hat:
  If Intersect(Target, Range("E8:E71")) Is Nothing Then Exit Sub
  With Target
    If .Count = 1 Then
      .Offset(0, 2) = .Offset(0, 2) + 1
    End If
  End With
End Sub

Am besten Du markierst die obigen Makros, kopierst sie in die Zwischenablage und fügst sie anstelle des Makros von Schatzi wieder ein (Das Makro von Schatzi ist in der 2. Private-Sub enthalten). Wo das Makro von Schatzi in Deiner Excel-Datei zu finden ist, das weißt Du ja.

 

Funktioniert super !!!

Danke !!!

 

Super Sache von Euch. Nur möchte ich wissen wie man die komultative Zählung in einer Zelle haben kann...
zB.: Ich ändere E7 und G7 zählt . Darauf ändere ich e8 und g7 zählt. Wenn ihr mir saen könntet wie man den Code dafür ändern müsste wäre ich euch sehr dankbar. Danke auch schon im voraus. :)

 

Hallo,

ausgehend von den Vorgaben der vorherigen Postings in diesem Thread, musst du die beiden rot gekennzeichneten Zeilen ändern, um eine (kumulative) Änderungszählung nur in Zelle G7 durchzuführen:

Code:

Option Explicit

Private Sub Worksheet_Calculate()
  'Dieses Ereignis tritt ein, nachdem das ARBEITSBLATT neu berechnet wurde
  Dim rngIstNeuberechnet As Range
  Dim rngVergleichswerte As Range
  Dim rngZelle As Range, SpalteZ_Diff As Long
  '
  'Bereich der Zellen, die überprüft werden sollen, ob sich durch Berechnungen ihr Wert geändert hat:
  '(Im Bereich G8:G71 sind die Zähler enthalten, die mitzählen, wie oft eine solche Zelländerung erfolgte)
  Set rngIstNeuberechnet = Range("E8:E71")
  '
  'Bereich der Zellen, die die Werte aus E8:E71 bis vor der letzten Neuberechnung des Arbeitsblattes enthalten:
  Set rngVergleichswerte = Range("Z8:Z71")  '<--- eventuell anderen Bereich wählen!!
  '
  SpalteZ_Diff = rngVergleichswerte.Column - rngIstNeuberechnet.Column
  Application.EnableEvents = False
  For Each rngZelle In rngIstNeuberechnet.Cells
    With rngZelle
      If .HasFormula Then
        If .Value <> .Offset(0, SpalteZ_Diff) Then
          .Offset(0, SpalteZ_Diff) = .Value
[COLOR="#FF0000"]          Range("G7").Value = Range("G7").Value + 1
[/COLOR]        End If
      End If
    End With
  Next rngZelle
  Application.EnableEvents = True
  '
End Sub
'
Private Sub Worksheet_Change(ByVal Target As Range)
  'Dieses Ereignis tritt ein, nachdem der User im Target-Bereich neue WERTE eingegeben hat:
  If Intersect(Target, Range("E8:E71")) Is Nothing Then Exit Sub
  With Target
    If .Count = 1 Then
[COLOR="#FF0000"]      Range("G7").Value = Range("G7").Value + 1
[/COLOR]    End If
  End With
End Sub

 

Hallo liebe Excel Freunde,
ich schreibe in diesem älteren Thread da er mir bei einem Problem geholfen hat. Dafür hat er ein neues Verursacht.

Ich habe den Code von Schatzi verwendet um Änderungen in Zellen zu zählen.

Das funktioniert auch super! Vielen Dank.

Was nun aber den Anwendern Probleme bereitet, ist das der "Rückgängig" Button oben links nicht mehr funktioniert. Wenn diese also aus Versehen einen Eintrag löschen können Sie diesen nicht wieder herstellen. Wir verwenden Excel 2016.

Habt ihr eine Idee wie ich Änderungen zählen kann und die Anwender gleichzeitig den Button verwenden können?

Vielen Dank schön einmal an alle die dies mitlesen und ein noch größeres Danke für alle Lösungsideen.

Gruß L

 

Hallo,

Code:

Option Explicit

Dim rngLetzteZelle As Range               'Zelle Spalte E
Dim varLetzterWert(1 To 2) As Variant     'Werte Spalte E Alt(=1) bzw Neu(=2)

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("E8:E71")) Is Nothing And Target.Count = 1 Then
     
     Set rngLetzteZelle = Target       'Merke Target-Zelle Spalte E
     varLetzterWert(2) = Target.Value  'Merke Target-NeuWert Spalte E
     On Error GoTo Err_Change
     With Application
        .EnableEvents = False
        .Undo                       '"Undo" um Target-AltWert Spalte E zu ermitteln!!
     End With
     With Target
        varLetzterWert(1) = .Value               'Merke Target-AltWert Spalte E
        .Value = varLetzterWert(2)               'Speichere Target-NeuWert Spalte E
        .Offset(0, 2).Value = .Offset(0, 2) + 1  'Speichere NeuWert Spalte G
     End With
Err_Change:
     With Application
        .EnableEvents = True
        .OnUndo Text:="UndoInkrem", Procedure:="[COLOR="#FF0000"]Tabelle1.[/COLOR]DekremSUB"
     End With
     
   End If
End Sub

Sub DekremSUB()
  Application.EnableEvents = False
  On Error GoTo Err_dekrem
  With rngLetzteZelle
    .Value = varLetzterWert(1)                    'Speichere Target-AltWert Spalte E
    .Offset(0, 2).Value = .Offset(0, 2).Value - 1 'Speichere AltWert Spalte G
  End With
Err_dekrem:
  Application.EnableEvents = True
End Sub

Installation:
Vorgenannte 2 Makros sind ins Codemodul des Arbeitsblattes zu kopieren anstelle deines Makros. Die rot gekennzeichnete Stelle ist der interne Name des Codemoduls - nicht zu verwechseln mit der Tabulator-Beschriftung des Arbeitsblattes, zu dem dieses Codemodul gehört! Dieser interne Name ist im Projektexplorer des VBA-Editors ersichtlich.
Sollte das Projekt-Explorer-Fenster im VBA-Editor nicht zu sehen sein, kann es mittels Tastenkombination Strg+R eingeblendet werden.
Dort sind in einer hierarchischen Auflistung die wichtigsten Objekte der Excel-Mappe zu sehen, angefangen vom "VBAProjekt (…)" über die "Microsoft Excel Objekte" und schließlich "DieseArbeitsmappe", "Tabelle1 (Test)", "Tabelle2 (Tabelle2), …"
Dabei ist der rot gekennzeichnete Eintrag exakt der im Makro an der roten Stelle benötigte Name, während der blau gekennzeichnete, in Klammern befindliche Eintrag die hier nicht benötigte Tab-Beschriftung des Arbeitsblattes ist.

Hinweise zum Ablauf:
1) Es werden im 1. Makro (Worksheet_Change) die benötigten Vorgängerwerte der Spalte E und G der betreffenden Zelle ermittelt, obwohl sie nicht mehr angezeigt werden im Arbeitsblatt
2) Es wird ein Makro (DekremSUB) als Undo-Makro festgelegt, wobei dieser Aktion der Name "UndoInkrem" zugewiesen wird. Dieser Name ist dann auch in der UNDO-Liste des UNDO-Pfeils im Arbeitsblatt sichtbar.
3) Wird der Undo-Pfeil nach Aktualisierung der Spalten E bzw. G gedrückt, werden erwartungsgemäß die Werte besagter Spalten wieder zurückgestellt auf ihre Altwerte.
4) Die Punkte 1)+2) sind für die Anwender ohne Belang - ich habe sie hier nur zum besseren Verständnis aufgeführt, sie laufen auch vollautomatisch ab.

 

Hallo Anton Exl,
erst einmal vielen Dank das du dich meinem Problem annimmst. Ich gestehe ich habe etwas Respekt vor der Aufgabe dies umzusetzen, habe mir aber den heutigen Vormittag dafür freigehalten. Ich habe leider nicht meine angepasste Version eingestellt und muss nun auch erfolgreich deinen Code auf meine Bereiche anpassen.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:AN500")) Is Nothing And Target.Count = 1 Then _
Target.Offset(0, 42) = Target.Offset(0, 42) + 1
End Sub

Ich Berichte von meinen Erfolgen.

Liebe Gruß L