Microsoft Excel

Herbers Excel/VBA-Archiv

Protokoll


Betrifft: Protokoll
von: Thomas
Geschrieben am: 14.12.2018 22:08:56

Hallo Excelfreunde,

ich möchte gern alle Änderungen im Arbeitsblatt protokollieren.

Das unten stehende Macro macht das schon ganz gut. Nun wird aber in den Tabellen-blättern auch sortiert. Somit verliere ich die Zuordnung von Target.Address zum dazugehörigen Datensatz. Ich habe in der ersten Spalte ( A) die jeweilige Datensatznummer.

Deshalb versuche ich gerade den Wert aus Spalte A ins Protokoll zu bekommen.

Kann mir jemand dabei helfen? Irgendwie funktioniert das nicht was ich ausgebrütet habe.

Habt schon mal recht vielen dank für euer Interesse-

MFG Thomas

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim lngZeile As Long
Dim spalte
Dim zeile
Dim wert
Application.EnableEvents = False
With Worksheets("Tabelle2")

lngZeile = .Range("A65536").End(xlUp).Row + 1

'###########################################################

' dies ist mein versuch


.Cells(lngZeile, 1).Value = Target.Column
.Cells(lngZeile, 2).Value = Target.Row
spalte = Target.Column
zeile = Target.Row
wert = Cells(spalte, zeile)
.Cells(lngZeile, 3).Value = wert
'###########################################################

.Cells(lngZeile, 4).Value = Application.UserName 'Benutzer
.Cells(lngZeile, 5).Value = Date 'Datum
.Cells(lngZeile, 6).Value = Time 'Zeit
.Cells(lngZeile, 7).Value = Sh.Name 'Blattname, auf dem geändert wurde
.Cells(lngZeile, 8).Value = Target.Address 'Zelle der Änderung
.Cells(lngZeile, 9).Value = Target.Value 'neuer Eintrag
End With
Application.EnableEvents = True
End Sub

  

Betrifft: AW: Protokoll
von: Sepp
Geschrieben am: 15.12.2018 02:25:33

Hallo Thomas,

als erstes würde ich das Protokoll-Blatt auch so benennen, dann würde ich diesen Code verwenden.

Microsoft Excel Objekt DieseArbeitsmappe

Option Explicit 
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
  Dim lngRow As Long 
 
  On Error GoTo ErrorHandler 
 
  If Sh.Name <> "Protokoll" Then 
    Application.EnableEvents = False 
    With Worksheets("Protokoll") 
      lngRow = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row + 1) 
      .Cells(lngRow, 1).Value = Application.UserName 'Benutzer 
      .Cells(lngRow, 2).Value = Date 'Datum 
      .Cells(lngRow, 3).Value = Time 'Zeit 
      .Cells(lngRow, 4).Value = Sh.Name 'Blattname, auf dem geändert wurde 
      .Cells(lngRow, 5).Value = Sh.Cells(1, Target.Column) 'Spalte 
      .Cells(lngRow, 6).Formula = "=HYPERLINK(""[" & ThisWorkbook.Name & "]'" & Sh.Name & "'!A""& MATCH(" & _
        Sh.Cells(Target.Row, 1) & ",'" & Sh.Name & "'!A:A,0)," & Sh.Cells(Target.Row, 1) & ")" 'Datensatznummer 
      .Cells(lngRow, 7).Value = Target.Value 'Neuer Eintrag 
    End With 
  End If 
 
ErrorHandler: 
  Application.EnableEvents = True 
End Sub 
 


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0





http://www.herber.de/bbs/user/126119.xlsm


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: besten dank an Sepp
von: Thomas
Geschrieben am: 15.12.2018 09:44:54

Hallo Sepp,

habe recht vielen Dank, das klappt super.


Ein schönen dritten Advent wünsch ich Dir.


MFG Thomas


  

Betrifft: AW: besten dank an Sepp
von: Sepp
Geschrieben am: 15.12.2018 10:50:35

Hallo Thomas,

danke für die Rückmeldung.

Anbei eine geänderte Version. Bei der Vorherigen liefen die Links ins Leere, wenn sich der Dateiname ändert, bei der Neuen wird der Dateiname über einen definierten Namen ermittelt und passt sich somit automatisch an.


http://www.herber.de/bbs/user/126123.xlsm

 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: cool aber kannst Du noch mal schauen?
von: Thomas
Geschrieben am: 15.12.2018 11:22:41

Hallo Sepp,

ich habe dein Code ausgetauscht.
Hab recht vielen dank für die Verbesserung das hatte ich noch nicht mal bemerkt.

Ich habe noch ein Codschnipsel für den alten Wert gefunden und eingebaut.

Kann man dies aus deiner Sicht so mit einbauen oder ist die eher dumm von mir?


MFG Thomas




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("A1: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



  

Betrifft: AW: cool aber kannst Du noch mal schauen?
von: Sepp
Geschrieben am: 15.12.2018 18:39:08

Hallo Thomas,

das ist aber nicht mein Code!

Ich würde es so lösen.

http://www.herber.de/bbs/user/126133.xlsm


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: klappt bei mir nicht ...
von: Matthias L
Geschrieben am: 15.12.2018 12:18:04

Hallo

Protokoll

 ABCDEFGH
2Benutzer15.12.201812:12:54 PMTabelle1  Hallo Sepp#NAME?
3Benutzer15.12.201812:13:14 PMTabelle1  klappt bei mir nicht!#NAME?

Formeln der Tabelle
ZelleFormel
H2=HYPERLINK(_FILE&"'Tabelle1'!A"&VERGLEICH(;Tabelle1!A:A;0);"Go…")
H3=HYPERLINK(_FILE&"'Tabelle1'!A"&VERGLEICH(;Tabelle1!A:A;0);"Go…")


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Ich lass offen wg. Thomas

Gruß Matthias


  

Betrifft: AW: klappt bei mir nicht ...
von: Sepp
Geschrieben am: 15.12.2018 18:28:20

Hallo Thomas,

bei dir fehlt der definierte Name '_FILE' und die Datei muss gespeichert sein.


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: _File existiert & Datei ist gespeichert ...
von: Matthias L
Geschrieben am: 15.12.2018 21:44:55

Hallo Sepp

Ich glaub das funktioniert nur mit Zahlen,



sonst will Vergleich einen definierten Namen als Suchkriterium haben.



Gruß Matthias


  

Betrifft: AW: _File existiert & Datei ist gespeichert ...
von: Sepp
Geschrieben am: 15.12.2018 22:06:03

Hallo Matthias,

logischer weise muss man, wenn man nach Texten sucht, den Suchbegriff auch als Text/String angeben.
Also muss man ihn in "" packen. Da aber in der ursprünglichen Aufgabe Nummern gesucht wurden, habe ich das nicht eingebaut.


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: Ich weiß und habs ja erkannt ;-) alles gut ... owT
von: Matthias L
Geschrieben am: 15.12.2018 22:21:26




  

Betrifft: besten dank Sepp das klappt
von: Thomas
Geschrieben am: 15.12.2018 22:51:57

Hallo ihr zwei,

habt besten dank das ihr euch dies angeschaut und verbessert habt.

Sepp ich nehme natürlich dein Code. Hab recht vielen dank das du ihn auch gleich eingebaut hast.

Ich wünsche euch ein schönen friedlichen 3. Advent.

MFG Thomas