Office: (Office 2013) Vba Änderungen Verfolgen Protokoll "Alter Wert" hinzufügen

Guten Tag,

ich würde gerne alle Änderungen die in einer Excel Tabelle gemacht werden in einem Extra Blatt bzw Datei Protokollieren.
Jedoch Fehlt mir der Wert " Alter Wert ". Könnte man diesen in den Quellcode noch irgendwo einbinden?

 

Hallo,

ich hoffe, folgende Makroänderung sollte den Zweck erfüllen:

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim ErsteFreieZeile As Long
  Dim AlterWert As Variant, NeuerWert As Variant
  Dim rngNeuSel As Range
  If Target.Count > 1 Then Exit Sub
  If Sh.Name = "Protokoll" Then Exit Sub
  If Intersect(Target, Sh.Range("A9:Q550")) Is Nothing Then Exit Sub
'------
  'Ereignisbehandlung ausschalten:
  Application.EnableEvents = False
  'Zwischenspeichern des neuen Wertes und der neuen Zellmarkierung
  NeuerWert = Target.Value
  Set rngNeuSel = Selection
  'Rückgängigmachen der letzten Aktion (=Zellwertänderung und Zellmarkierung):
  Application.Undo '<-- Des Pudels Kern, um alten Zellwert wieder zu bekommen
  'Alten Zellwert zwischenspeichern
  AlterWert = Target.Value
  'Neuen Zellwert aus der Zwischenspeicherung zurückholen in die geänderte Zelle
  Target.Value = NeuerWert
  'Ebenso die neue Zellmarkierung wieder neu setzen
  On Error Resume Next
  rngNeuSel.Activate
  On Error GoTo 0
'------
  With Sheets("Protokoll")
    ErsteFreieZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(ErsteFreieZeile, 1) = Sh.Name
    .Cells(ErsteFreieZeile, 2) = Target.Address(0, 0)
    .Cells(ErsteFreieZeile, 3) = Target.Value
    .Cells(ErsteFreieZeile, 4) = Date
    .Cells(ErsteFreieZeile, 5) = Time
    .Cells(ErsteFreieZeile, 6) = Environ("username")
    .Cells(ErsteFreieZeile, 7) = AlterWert            '<---- Ausgeben
  End With
'------
  'Ereignisbehandlung wieder einschalten:
  Application.EnableEvents = True
End Sub

Den Codeabschnitt mit der entscheidenden Funktionalität habe ich mit ausführlichem Kommentar versehen.
Bei der händischen Bedienung kommt man an den alten Zellwert dadurch heran, indem man den Rückgängig-Befehl ausführt. In einem VBA-Makro erledigt dies der Befehl "Application.Undo". Dabei muss man Vorsorge treffen, dass man den neuen Zellwert und die neue Zellmarkierung wieder zurückerhält (--> Zwischenspeicherung).

 

Hat sich erledigt

 

Hallo,

ist es bei dieser Variante auch möglich, dass Löschungen auch in der Liste erfasst werden?

Dann würde der neue Wert 0 "leer" und der alte Wert angezeigt.

Vielen Dank vorab und schönen Gruß
Hobi

 

Hallo zusammen,
Super Makro. Genau was ich gesucht habe.
Doch leider funktioniert die "Rückgängig machen" Funktion über die Pfeiltasten aufgrund der Ausführung der Makros nicht mehr.

Meine Frage ist, ob man das irgendwie umgehen kann?
1. Bspw. dass die Makros erst mit dem Speichern ausgeführt werden?
2. Oder durch ein gesondertes Skript, das alle Makros solange zurückhält bis man einen Button betätigt?
3. Oder durch einen eigenen "Rückgängig machen" Button, der so definiert ist, dass man damit ausgeführte Makros rückgängig machen kann?

Über eine Antwort würde ich mich freuen.

Viele Grüße
Robert

 

Hallo Robert,

sieht man in der Microsoft-Hilfe zur Undo-Methode des Excel-Application-Objektes nach, findet man folgende Information:

d.h. führt man die Undo-Methode nur 1x aus, wird die letzte händische Aktion in der Benutzeroberfläche rückgängig gemacht.
Will man, dass nicht (fast) jede Aktion in der Benutzeroberfläche damit rückgängig gemacht wird, muss man zuvor präzise einschränken, was davon betroffen sein soll und was nicht.

Vorgenanntes Makro tritt prinzipiell in Aktion, wenn sich in irgendeinem Arbeitsblatt der Arbeitsmappe ein Zellwert (bzw.mehrere Zellwerte) geändert hat (haben). Fügt man nach Aufruf des Makros keine Einschränkungen ein, wird jedwede Zellwertänderung aufgrund von Benutzereingaben mit dem enthaltenen Undo-Prozedere beantwortet.
Deshalb ist im vorgenannten Makro folgende Einschränkung enthalten:

Die Undo-Methode ist nur dazu da, die letzte(n) Aktion(en) rückgängig zu machen, und nicht wirklich dazu da, ganze Zellhistorien zwischenzuspeichern, um sie dann irgendwann abzurufen. Man wird bei allen in Excel möglichen Vorgängen Probleme heraufbeschwören, wenn man sie für etwas einsetzt, für das sie nicht bestimmt sind.

 

Hallo Anton,

Vielen Dank für deine ausführliche Erklärung.

Ich habe die Rückgängigmachen-Funktion jetzt mit einem Button (aktivieren/deaktivieren) zur automatischen Speicherung gelöst.
Sobald die Protokollfunktion aktiv ist, wird die Datei sofort - und zur Sicherheit im selben Verzeichnis alle 10 Minuten mit Zeitstempel gespeichert. Damit kann ich einfach auf eine frühere Datei wieder zurückgreifen.

Ein Merkmal würde ich aber gern noch im Protokoll aufnehmen:

1. Gesucht wird ein neuer Wert für Spalte 8 im Protokoll, also nachfolgende Erweiterung:
.Cells(ErsteFreieZeile, 8) = target.value ... ??

2. "neuer Wert"
- gleiche Zeile des "target.value" (also Zeile der Änderung)
- jedoch soll der Wert aus "Spalte C" aus Tabellenblatt "Tabelle1" wiedergegeben werden und zwar nur, wenn in "Tabelle1" eine Änderung durchgeführt wurde.

Vorsicht vor evtl. Debug: da nachfolgenden Befehl in meinem Skript deaktiviert wurde (') . Im Bereiche (Target.Address(0,0) lass ich mir somit auch Bereiche anzeigen.
'If Target.Count > 1 Then Exit Sub

Hintergrund zur Einführung des Merkmals:

Angenommen "Tabelle1" ist eine Datenbank und in "Spalte C" stehen die Projekte, dann könnte ich sehr schnell im "Protokoll" nach Projekten sortieren/filtern.

Hast du/jemand eine Idee, wie man das umsetzen könnte?

Danke schon im Voraus.

Viele Grüße
Robert

 

Hallo,

ich habe dir im folgenden Makro für die Callback-Routine des Workbook_SheetChange-Events deine Änderungswünsche eingebaut:

Code:

Option Explicit
'
'Im Arbeitsblattobjekt Sh mit Tabulatorbezeichnung Sh.Name
'fand im Zellbereich Target eine Wertänderung statt aufgrund einer Benutzereingabe.
'Dieses Ereignis bewirkt die Ausführung der folgenden SUB:
'
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim ErsteFreieZeile As Long
  Dim AlterWert As Variant, NeuerWert As Variant
  Dim rngNeuSel As Range
'------
' MsgBox "Zellanzahl: " & Target.Count
'  Einschränkungen (Exklusionen):
' If Target.Count > 1 Then Exit Sub
  If Sh.Name = "Protokoll" Then Exit Sub
  If Intersect(Target, Sh.Range("A9:Q550")) Is Nothing Then Exit Sub
'------
  'Wegen vorgenannter Einschränkungen wird das Folgende nur ausgeführt, wenn
  '1)
  '2) Target NICHT im Arbeitsblatt Sh mit der Bezeichnung "Protokoll" liegt UND
  '3) Target im Zellbereich A9:Q550 des Arbeitsblattes Sh liegt
'------
  'Ereignisbehandlung ausschalten:
  Application.EnableEvents = False
  'Zwischenspeichern des neuen Wertes und der neuen Zellmarkierung
  NeuerWert = Target.Value
  Set rngNeuSel = Selection
  'Rückgängigmachen der letzten Aktion (=Zellwertänderung und Zellmarkierung):
  Application.Undo '<-- Des Pudels Kern, um alten Zellwert wieder zu bekommen
  'Alten Zellwert zwischenspeichern
  AlterWert = Target.Value
  'Neuen Zellwert aus der Zwischenspeicherung zurückholen in die geänderte Zelle
  Target.Value = NeuerWert
  'Ebenso die neue Zellmarkierung wieder neu setzen
  On Error Resume Next
  rngNeuSel.Activate
  On Error GoTo 0
'------
  With Sheets("Protokoll")
    ErsteFreieZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    With .Rows(ErsteFreieZeile) '.EntireRow
       .Cells(1) = Sh.Name
       .Cells(2) = Target.Address(0, 0)
       .Cells(3) = Target.Range("A1").Value
       .Cells(4) = Date
       .Cells(5) = Time
       .Cells(6) = Environ("username")
       .Cells(7) = AlterWert                 '<---- Ausgeben
       .Cells(8) = Target.EntireRow.Cells(3) '<---- 1.Zeile v.Target, Spalte C von Sh
    End With
  End With
'------
  'Ereignisbehandlung wieder einschalten:
  Application.EnableEvents = True
End Sub

Dieses Makro in das Codemodul "DieseArbeitsmappe" (bzw. "ThisWorkbook") der Arbeitsmappe kopieren (anstelle des bisherigen).
Änderungen:
1) Mehrzelliger Änderungsbereich (anstatt 1 Zelle) im Quellblatt möglich (insbesondere bei Löschvorgängen).
2) Zusätzliche Spalte im "Protokoll"-Blatt (Spalte H) gemäß deinen Wünschen.

 

Hallo Anton,
wow, herzlichen Dank für deinen Support! Wirklich toll vielen Dank!

Ich habe in das Skript noch ein wenig verändert.
Nur leider funktioniert die "Laufende Nummer" nicht mehr.

Vorher hat es noch geklappt.
Kannst du helfen?

Vielen Dank schon im Voraus und viele Grüße
Robert

With Sheets("Log_Data")
ErsteFreieZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
With .Rows(ErsteFreieZeile) '.EntireRow

.Cells(1) = .Cells(ErsteFreieZeile - 1, 1) + 1
.Cells(2) = Sh.Name
.Cells(3) = Target.EntireRow.Cells(3) '<---- 1.Zeile v.Target, Spalte C von Sh
.Cells(4) = Target.EntireRow.Cells(4) '
.Cells(5) = Target.Address(0, 0)
.Cells(6) = Target.Range("A1").Value
.Cells(7) = AlterWert
.Cells(8) = Format(Now, "yyyy.mm.dd")
.Cells(9) = Format(Time, "hh:mm")
.Cells(10) = Environ("username")

If .Cells(6) = "" Then .Cells(6) = "Löschung"

End With
End With

 

Hallo Anton,
eins habe ich noch vergessen.

Ich möchte nicht nur Tabellenblatt (Tabelle1) überwachen, sondern alle Tabellenblätter außer das Blatt, wo das Protokoll mitgeschrieben wird.
Die Eintragung in .Cells(3) und .Cells(4) soll aber nur dann erfolgen, wenn in Tabelle1 eine Änderung erfolgt.

Hintergrund:
Dort liegt die Datenbank. Die anderen Tabellen sind nur Hilfstabellen, die aber auch protokolliert werden sollen.

Geht das einfach umzuschreiben?

Viele Grüße
Robert

 

Hallo,

Änderungen ins Makro eingebaut:

Code:

Option Explicit
'
'Im Arbeitsblattobjekt Sh mit Tabulatorbezeichnung Sh.Name
'fand im Zellbereich Target eine Wertänderung statt aufgrund einer Benutzereingabe.
'Dieses Ereignis bewirkt die Ausführung der folgenden SUB:
'
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim ErsteFreieZeile As Long
  Dim AlterWert As Variant, NeuerWert As Variant
  Dim rngNeuSel As Range
'------
' MsgBox "Zellanzahl: " & Target.Count
'  Einschränkungen (Exklusionen):
' If Target.Count > 1 Then Exit Sub
  If Sh.Name = "Log_Data" Then Exit Sub
  If Intersect(Target, Sh.Range("A9:Q550")) Is Nothing Then Exit Sub
'------
  'Wegen vorgenannter Einschränkungen wird das Folgende nur ausgeführt, wenn
  '1)
  '2) Target NICHT im Arbeitsblatt Sh mit der Bezeichnung "Protokoll" liegt UND
  '3) Target im Zellbereich A9:Q550 des Arbeitsblattes Sh liegt
'------
  'Ereignisbehandlung ausschalten:
  Application.EnableEvents = False
  'Zwischenspeichern des neuen Wertes und der neuen Zellmarkierung
  NeuerWert = Target.Value
  Set rngNeuSel = Selection
  'Rückgängigmachen der letzten Aktion (=Zellwertänderung und Zellmarkierung):
  Application.Undo '<-- Des Pudels Kern, um alten Zellwert wieder zu bekommen
  'Alten Zellwert zwischenspeichern
  AlterWert = Target.Value
  'Neuen Zellwert aus der Zwischenspeicherung zurückholen in die geänderte Zelle
  Target.Value = NeuerWert
  'Ebenso die neue Zellmarkierung wieder neu setzen
  On Error Resume Next
  rngNeuSel.Activate
  On Error GoTo 0
'------
  With Sheets("Log_Data")
    ErsteFreieZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    With .Rows(ErsteFreieZeile)
       .Cells(1) = .Cells(ErsteFreieZeile - 1, 1) + 1
       .Cells(2) = Sh.Name
       If Sh.Name = "Tabelle1" Then
         .Cells(3) = Target.EntireRow.Cells(3) '<---- 1.Zeile v.Target, Spalte C von "Tabelle1"
         .Cells(4) = Target.EntireRow.Cells(4) '<---- 1.Zeile v.Target, Spalte D von "Tabelle1"
       End If
       .Cells(5) = Target.Address(0, 0)
       .Cells(6) = Target.Range("A1").Value
       .Cells(7) = AlterWert
       .Cells(8) = Format(Date, "yyyy.mm.dd")  'Datums-STRING  !!
       .Cells(9) = Format(Time, "hh:mm")       'Uhrzeit-STRING !!
       .Cells(10) = Environ("username")
    End With
  End With
'------
  'Ereignisbehandlung wieder einschalten:
  Application.EnableEvents = True
End Sub

 

Hallo Anton,
vielen lieben Dank für deine Antwort.
Leider funktioniert die "laufende Nummer" in Cells(1) immer noch nicht.
Hier wird nur 1,1,1... gezählt.

If .Cells(6) = "" Then .Cells(6) = "Löschung"
Kann man diese Funktion grundsätzlich für Cells(6) so einbauen? Ich möchte halt, dass bei einem Löschvorgang etwas in der Zelle drin steht.

Vielen Dank für dein Support und viele Grüße
Robert

 

Hallo Anton,
ich habe mal ein bisschen rum probiert.
Also, die laufende Nummer funktioniert nur im Sheet("Log_Data"). (Falls - If Sh.Name = "Log_Data" - aktiviert ist).
Aber wenn ich eingaben in Tabelle1 oder Tabelle2 vornehme, dann wird nicht fortlaufend gezählt.
Ich weiß leider nicht weiter. Wäre schön, wenn du hierfür eine Lösung hättest.
Viele Grüße
Robert

 

Hallo,

die korrekte Zeile lautet: ".Cells(1) = .Cells(0,1)+1"

Code:

Option Explicit
'
'Im Arbeitsblattobjekt Sh mit Tabulatorbezeichnung Sh.Name
'fand im Zellbereich Target eine Wertänderung statt aufgrund einer Benutzereingabe.
'Dieses Ereignis bewirkt die Ausführung der folgenden SUB:
'
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim ErsteFreieZeile As Long
  Dim AlterWert As Variant, NeuerWert As Variant
  Dim rngNeuSel As Range
'------
' MsgBox "Zellanzahl: " & Target.Count
'  Einschränkungen (Exklusionen):
' If Target.Count > 1 Then Exit Sub
  If Sh.Name = "Log_Data" Then Exit Sub
  If Intersect(Target, Sh.Range("A9:Q550")) Is Nothing Then Exit Sub
'------
  'Wegen vorgenannter Einschränkungen wird das Folgende nur ausgeführt, wenn
  '1)
  '2) Target NICHT im Arbeitsblatt Sh mit der Bezeichnung "Log_Data" liegt UND
  '3) Target im Zellbereich A9:Q550 des Arbeitsblattes Sh liegt
'------
  'Ereignisbehandlung ausschalten:
  Application.EnableEvents = False
  'Zwischenspeichern des neuen Wertes und der neuen Zellmarkierung
  NeuerWert = Target.Value
  Set rngNeuSel = Selection
  'Rückgängigmachen der letzten Aktion (=Zellwertänderung und Zellmarkierung):
  Application.Undo '<-- Des Pudels Kern, um alten Zellwert wieder zu bekommen
  'Alten Zellwert zwischenspeichern
  AlterWert = Target.Value
  'Neuen Zellwert aus der Zwischenspeicherung zurückholen in die geänderte Zelle
  Target.Value = NeuerWert
  'Ebenso die neue Zellmarkierung wieder neu setzen
  On Error Resume Next
  rngNeuSel.Activate
  On Error GoTo 0
'------
  With Sheets("Log_Data")
    ErsteFreieZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    With .Rows(ErsteFreieZeile)
       .Cells(1) = .Cells(0, 1) + 1
       .Cells(2) = Sh.Name
       If Sh.Name = "Tabelle1" Then
         .Cells(3) = Target.EntireRow.Cells(3) '<---- 1.Zeile v.Target, Spalte C von "Tabelle1"
         .Cells(4) = Target.EntireRow.Cells(4) '<---- 1.Zeile v.Target, Spalte D von "Tabelle1"
       End If
       .Cells(5) = Target.Address(0, 0)
       .Cells(6) = Target.Range("A1").Value
       .Cells(7) = AlterWert
       .Cells(8) = Format(Date, "yyyy.mm.dd")  'Datums-STRING  !!
       .Cells(9) = Format(Time, "hh:mm")       'Uhrzeit-STRING !!
       .Cells(10) = Environ("username")
    End With
  End With
'------
  'Ereignisbehandlung wieder einschalten:
  Application.EnableEvents = True
End Sub

 

Hallo Anton,
super, funktioniert einwandfrei!
Vielen herzlichen Dank für deinen Support!

Schönen Sonntag noch und viele Grüße
Robert