Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
1064to1068
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Änderungen überwachen

Änderungen überwachen
Winkler
Hallo,
ich benötige bitte eure Hilfe, denn ich habe leider keine Excel-VBA-Erfahrung (Habe mir aber schon ein Buch gekauft damit ich das bald ändern kann :-))
Also, ich habe eine Tabelle, auf der mehrere Benutzer zugreifen und Änderungen vornehmen. Ich möchte am liebsten in einer Extra-Tabelle all diese Änderungen automatisch registrieren. Vielleicht so:
Benutzername: muellerj
Datum: 07.04.09; 13:00 Uhr
Änderungen: Zelle B6 - 03.05.09 zu 07.04.09 geändert
Zelle A12 - Horst Müller zu Lisa Krause geändert
usw.
Wenn ihr mir helfen könntet wäre ich euch sehr, sehr dankbar.
Viele Grüße Denny
AW: Änderungen überwachen
Hajo_Zi
Hallo Denny,
vieleicht reicht schon Register, Überprüfen, Befehlsgruppe Änderungen.

AW: Änderungen überwachen
Winkler
Hallo Hajo,
zunächst vielen Dank für deine Antwort. Leider verstehe ich nicht.... ;-(
AW: Änderungen überwachen
Hajo_Zi
Hallo
das verstehe ich nicht, was ist daran kompliziert das Register Überprüfen anzuklicken und wenn man lesen kann findetr man auch die Befehlsgruppe Änderungen und da steht Änderungen nachverfolgen.
Gruß Hajo
nee nee..HaJo HaJo...
Oberschlumpf
Hi
Meinste nich, dass n bissi mehr FREUNDLICHKEIT auch für DICH gelten sollte?!!?
Überlege doch mal, wie deine Erst-Antworten verstanden oder eben auch nicht verstanden werden.
Oft habe ich von dir schon Antworten gelesen, bei denen ich dann dachte:
"Uihh uihh, um DAS, was HaJo da gerad geschrieben hatte, verstehen zu können, müsste der Fragende eigentlich soo viel Excel-Kenntnisse besitzen, dass er seine Frage selbst beantworten kann."
Aber...ein Fragender hat (noch) nicht immer DAS Wissen, welches DU voraussetzt, um deine Hilfen immer verstehen zu können.
(weil ihm oder ihr manchmal das erforderliche Wissen fehlt, fragt er/sie ja hier nach)
Also...."bestücke" bitte in Zukunft deine Antworten mit ein bisschen viel mehr Text, damit auch ein Neuling oder Ungeübter sich besser in deinen "Menü-Untermenü-usw-Navigationen" und anderen, leider sehr oft sehr kurz gehaltenen Antworten zurecht findet.
Natürlich ist und bleibt es deine Sache, dieser meiner eben gestellten Bitte nachzukommen.
Ciao
Thorsten
Anzeige
AW: Änderungen überwachen
Winkler
Hallo Hajo,
das wusste ich leider noch nicht. Vielen Dank für die Info.
AW: Änderungen überwachen
Tino
Hallo,
sollte der Vorschlag von Hajo nicht ausreichen oder funktionieren, aus welchem Grund auch immer.
Hier noch ein Vorschlag.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range, FZelle As Range

For Each Bereich In Target
 
    With Sheets("Ueberwachung") 'Tabellenname anpassen 
     Set FZelle = .Columns(3).Find(Bereich.Address, , xlValues, 2, 1, 1, False, False, False)
     
     If FZelle Is Nothing Then
      Set FZelle = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
     Else
      Set FZelle = FZelle.Offset(0, -2)
     End If
     
     With FZelle
      .Value = Environ$("Username")
      .Offset(0, 1).Value = Format(Now, "hh:mm dd.mm.yy")
      .Offset(0, 2).Value = Bereich.Address
      
      If .Offset(0, 3).Value <> .Offset(0, 4).Value Then
        .Offset(0, 3).Value = .Offset(0, 4).Value
      End If
      
      .Offset(0, 4).Value = Bereich.Value
     End With
    
    End With
Next Bereich

End Sub


Kommt als Code in die entsprechende Tabelle.
Allerdings sind noch Grenzen gesetzt, weil es mehr Zellen gibt als Zeilen.
Sonst würde ich es in eine Externe Textdatei auslagern, eventuell eine Art ini Datei müsste man mal austesten.
Gruß Tino

Anzeige
AW: Änderungen überwachen
Winkler
Hallo Tino,
vielen Dank. Das ist Spitze!!!!!!!!!!! So in etwa habe ich mir das vorgestellt....
Super... ;-))) Ich versuche gleich mal deine Programmierung mit meinen "Kenntnissen" zu interpretieren.
LG Denny
AW: Änderungen überwachen
Winkler
Hallo Tino,
ein Frage hätte ich noch. Über die Zeit wird ja die Änderungen-Tabelle ziemlich groß. Vielleicht könntest du mir noch verraten, wie das mit der Text-Datei funktioniert?
Danke
AW: Änderungen überwachen
Tino
Hallo,
eventuell wäre es sinnvoll den Bewegungsradius der User einzuschränken.
Schütze das entsprechende Tabellenblatt mit einem Passwort.
Fügen in DieseArbeitsmappe diesen Code ein.
Option Explicit

Private Sub Workbook_Open()
    With Sheets("Tabelle1")
     .Protect "xxx", , , , True
     .ScrollArea = Range("A1:Z2000").Address
     .Cells.Locked = True
     .Range("A1:Z2000").Locked = False
    End With
End Sub


Jetzt kann der User sich nur noch im Bereich A1:Z2000 bewegen.
Damit wird die Überwachungstabelle nicht überfordert,
wenn der User mal die ganze Tabelle ändern möchte.
Eventuell den Bereich noch weiter einschränken.
Das mit der Textdatei, versuche mal ein Beispiel aufzubauen, kann aber etwas dauern.
Gruß Tino

Anzeige
AW: Änderungen überwachen
Winkler
Hallo Tino,
vielen Dank. Ich versuche deinen Code mal anzupassen.
Das ich die Lösung mit der Text-Datei nicht gleich erwarten kann, ist doch vollkommen klar. Bin froh, wenn ich überhaupt eine Lösung habe.
Danke dir!
AW: Änderungen überwachen
Tino
Hallo,
funktioniert der Vorschlag von Hajo?
Wenn der funzt, kann ich mir dir Arbeit sparen.
Gruß Tino
AW: Änderungen überwachen
Hajo_Zi
Hallo Tino,
dabei wird nur die letzte Änderung angezeigt in der Zelle angezeigt.
Gruß Hajo
AW: Änderungen überwachen
Winkler
Hallo,
leider nur begrenzt für meinen Anwendungsfall. Ich glaube die Text-Datei wäre das optimale... Wäre super, wenn du mir das vielleicht noch machen könntest...
Anzeige
AW: Änderungen überwachen
Tino
Hallo,
ok. hier mal ein Beispiel.
Es wird im Ordner der Exceldatei eine ini angelegt mit dem Namen Daten.ini.
Wie oben aber schon beschrieben, würde ich den Bereich einschränken sonst dauert das schreiben zu lange.
Persönlich finde ich den Vorschlag von Hajo aber schon besser.
kommt als Code in die Tabelle
Option Explicit 
 
 
Dim iniClass As Klasse1 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
Dim Bereich As Range, FZelle As Range 
Dim strString As String, AlterWert As String 
Set iniClass = New Klasse1 
    For Each Bereich In Target 
        strString = Environ$("Username") & ";" & Format(Now, "hh:mm dd.mm.yy") & ";" & Bereich.Value 
     
        AlterWert = iniClass.GetPrivateProfileString("AlterWert", Bereich.Address) 
         
        iniClass.WritePrivateProfileString "NeuerWert", Bereich.Address, strString & "  --> alter Wert:" & AlterWert 
        iniClass.WritePrivateProfileString "AlterWert", Bereich.Address, strString 
         
    Next Bereich 
Set iniClass = Nothing 
End Sub 
 

Klassenmodul Klasse1

Option Explicit 
 
Private Declare Function GetPrivateProfileString_ Lib "kernel32" _
 Alias "GetPrivateProfileStringA" ( _
 ByVal lpApplicationName As String, _
 ByVal lpKeyName As Any, _
 ByVal lpDefault As String, _
 ByVal lpReturnedString As String, _
 ByVal nSize As Long, _
 ByVal lpFileName As String) As Long 
 
Private Declare Function WritePrivateProfileString_ Lib "kernel32" _
 Alias "WritePrivateProfileStringA" ( _
 ByVal lpApplicationName As String, _
 ByVal lpKeyName As String, _
 ByVal lpDefault As String, _
 ByVal lpFileName As String) As Long 
 
 
Public Function GetPrivateProfileString(Sektion$, Key$) As String 
Dim A As Long, Wert As String, Datei As String 
Datei$ = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\") 
Datei$ = Datei$ & "Daten.ini" 
     
    Wert = Space$(255) 
    A = GetPrivateProfileString_(Sektion$, Key$, "", Wert$, Len(Wert$), Datei$) 
    GetPrivateProfileString = Left$(Wert$, A&) 
     
End Function 
 
Public Function WritePrivateProfileString(ByVal Sektion$, ByVal Key$, ByVal Wert$) 
Dim A As Long, Datei As String 
 
Datei$ = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\") 
Datei$ = Datei$ & "Daten.ini" 
  
A = WritePrivateProfileString_(Sektion$, Key$, Wert$, Datei$) 
     
End Function 


Gruß Tino

Anzeige
AW: Änderungen überwachen
Winkler
Hallo Tino,
ich habe den Code eingetragen und auch das Klassenmodul. Wo wird denn die Daten.ini abgelegt? Irgendwie passiert nix...
AW: Änderungen überwachen
Tino
Hallo,
wenn die Datei gespeichert ist im Ordner der Datei.
Gruß Tino
AW: Änderungen überwachen
Winkler
Alles klar, ich habe das Problem gefunden. Nun klappts... Sehr fein. Danke!!!!!!! Äh, ich hätte noch eine Frage. Wenn ich den Bsp. nehme, wo die Änderungen dirket in Excel aufgeführt werden. Kann mann da die Beutzer einschränken, d.h. eigentlich machen "nur" drei Benutzer änderungen die ich nachvollziehen muss. Wenn ich deren Namen irgendwo in deinem Code hinterlege, dann würde die Erfassung nicht so voll werden, oder? Den Erfassungsbereich einzuschränken glaube ich bringt nicht so viel. Es handelt sich sich um die Zellen: A3:BD4503

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range, FZelle As Range
For Each Bereich In Target
With Sheets("Ueberwachung") 'Tabellenname anpassen
Set FZelle = .Columns(3).Find(Bereich.Address, , xlValues, 2, 1, 1, False, False, False)
If FZelle Is Nothing Then
Set FZelle = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
Else
Set FZelle = FZelle.Offset(0, -2)
End If
With FZelle
.Value = Environ$("Username")
.Offset(0, 1).Value = Format(Now, "hh:mm dd.mm.yy")
.Offset(0, 2).Value = Bereich.Address
If .Offset(0, 3).Value  .Offset(0, 4).Value Then
.Offset(0, 3).Value = .Offset(0, 4).Value
End If
.Offset(0, 4).Value = Bereich.Value
End With
End With
Next Bereich
End Sub


Anzeige
AW: Änderungen überwachen
Winkler
Bin mir nicht ganz sicher, aber bei der Daten ini werden die Daten doppelt ausgegeben, oder? Der alte Wert entspricht dem Neuen....
AW: Änderungen überwachen
Tino
Hallo,
Ok. Habe noch ein bar Änderungen eingebaut, die Klasse bleibt wie gehabt.
Dim iniClass As Klasse1

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range, FZelle As Range
Dim strString As String, AlterWert As String
Set iniClass = New Klasse1
    For Each Bereich In Target
        strString = Environ$("Username") & ";" & Format(Now, "hh:mm dd.mm.yy") & ";" & Bereich.Value
    
        AlterWert = iniClass.GetPrivateProfileString("AlterWert", Bereich.Address)
        
        iniClass.WritePrivateProfileString "NeuerWert", Bereich.Address, strString & "  --> alter Wert:" & AlterWert
        
        If AlterWert = "" Then
         iniClass.WritePrivateProfileString "AlterWert", Bereich.Address, strString
        ElseIf Right$(AlterWert, Len(AlterWert) - InStrRev(AlterWert, ";")) <> Bereich.Value Then
         iniClass.WritePrivateProfileString "AlterWert", Bereich.Address, strString
        End If
        
    Next Bereich
Set iniClass = Nothing
End Sub


Gruß Tino

Anzeige
AW: Änderungen überwachen
Tino
Hallo,
meinst Du so?
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Bereich As Range, FZelle As Range
 
 For Each Bereich In Target
  
     With Sheets("Ueberwachung") 'Tabellenname anpassen 
      Set FZelle = .Columns(3).Find(Bereich.Address, , xlValues, 2, 1, 1, False, False, False)
      
      If FZelle Is Nothing Then
       Set FZelle = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
      Else
       Set FZelle = FZelle.Offset(0, -2)
      End If
      
      With FZelle
       .Value = sUserName
       .Offset(0, 1).Value = Format(Now, "hh:mm dd.mm.yy")
       .Offset(0, 2).Value = Bereich.Address
       
       If .Offset(0, 3).Value <> .Offset(0, 4).Value Then
         .Offset(0, 3).Value = .Offset(0, 4).Value
       End If
       
       .Offset(0, 4).Value = Bereich.Value
      End With
     
     End With
 Next Bereich
 
 End Sub

Private Function sUserName() As String
 Select Case Environ$("Username")
  Case "Name1": sUserName = "Schulze"
  Case "Name2": sUserName = "Meyer"
  Case "Name3": sUserName = "Hans"
  Case Else: sUserName = Environ$("Username")
 End Select
End Function


Gruß Tino

Anzeige
AW: Änderungen überwachen
Winkler
Hallo Tino,
zu den Änderungen die in Excel geschrieben werden:
Ich sehe da irgendwie keine Änderung. Es wird mein Benutzername aufgeührt, wann und was ich geändert habe. Günstig wäre es, wenn z.B. nur die Änderungen von z.B. guskemar, sandradoe erfasst würden. Nur diese sind eigentlich wichtig. Weißt du, ich bin Verwalter von der Tabelle und die zwei Benutzer pflegen diese. Leider gibt es dabei immer Schwierigkeiten und ich suche dann nach dem Fehler, was viel Zeit kostet. So wüsste ich gleich was die beiden wo verändert haben.
zu den Änderungen, registriert in der Daten. ini
Das ist do super. Nur verstehe ich nicht ganz den Zusammenhang. Es steht da: Neuer Wert: aaaa - alter Wert bbbb und eine Zeile tiefer ebenfalls: Alter Wert: aaaa ?
Ich kann mich leider nicht mehr als bedanken bei dir für deine Mühe!!!!!!!!!!!
Anzeige
AW: Änderungen überwachen
Tino
Hallo,
Du must auch die Namen die von Environ$("Username") ausgegeben werden,
durch die die ich verwendet habe (Name1, Name2 u. Name3) austauschen.

Private Function sUserName() As String
Select Case Environ$("Username")
Case "Name1": sUserName = "Schulze"
Case "Name2": sUserName = "Meyer"
Case "Name3": sUserName = "Hans"
Case Else: sUserName = Environ$("Username")
End Select
End Function


Gruß Tino

AW: Änderungen überwachen
Winkler
Versteh nich ganz. So?

Private Function sUserName() As String
Select Case Environ$("Username")
Case "Wink": sUserName = "Wink"
Case "Name2": sUserName = "guskemar"
Case "Name3": sUserName = "doerings"
Case Else: sUserName = Environ$("Username")
End Select
End Function


AW: Änderungen überwachen
Winkler
Ich weiß, ich nerve dich bestimmt, sorry..... Ich probiere schon die ganze Zeit rum, nur leider komme ich nicht weiter und du bist wohl der einzige der weiß wie.
Bitte, erklär mir nochmal das mit den Username und die eEinteilung Alter Wert-Neuer Wert.
AW: Änderungen überwachen
Tino
Hallo,
Environ$("Username") gibt den am Rechner angemeldeten Username zurück.
Dieser Name wird geprüft und bei Übereinstimmung,
entsprechend der andere Namen dafür eingesetzt.
Mach einfach mal ein leeres Modul zum testen und schreibe diesen Code rein.

Sub MeinAnmeldeName()
MsgBox Environ$("Username")
End Sub


Den Anmeldename findest Du auch in der Systemsteuerung unter System Umgebungsvariablen.
Gruß Tino

AW: Änderungen überwachen
Winkler
Hallo,
das ist schon klar. Die Frage ist, wo ich die drei anderen Benutzer, deren Änderungen erfasst werden, ergänzen muss. Bei "name1" oder bei sUserName.
Die zweit ist, warum wird der Alte Wert extra eränzt owohl er oben auch aufgeführt wird.
AW: Änderungen überwachen
Tino
Hallo,
bei Name2 und Name3 kommt der Name rein der von Environ beim User zurückgegeben wird.
Bei Meyer und Hans der entsprechend richtige Name.
Der Wert unten wird eingetragen, wenn dieser sich gegenüber dem neuen in dieser Zelle ändert,
sonst habe ich keinen Vergleich.
Gruß Tino
AW: Änderungen überwachen
Winkler
Hallo,
wenn ich aber meinen Benutzernamen nicht angebe, wird er trotzdem bei Änderungen verwendet:

Private Function sUserName() As String
Select Case Environ$("Username")
Case "doerings": sUserName = "Döring"
Case "guskemar": sUserName = "Guske"
Case "denckert": sUserName = "Dencker"
Case Else: sUserName = Environ$("Username")
End Select
End Function


Der alte Wert steht aber auch oben hinter dem neuen.

AW: Änderungen überwachen
Tino
Hallo,
Dies habe ich zur Sicherheit eingebaut, ist der Name nicht dabei,
wird der angemeldete Username verwendet.
Dies macht diese Zeile
Case Else: sUserName = Environ$("Username")
Einfach löschen wenn Du dies nicht möchtest.
Gruß Tino
AW: Änderungen überwachen
Winkler
Hallo,
habe ich gemacht. Meine Änderungen schreibt er leider doch noch hin.
jetzt ist der Groschen gefallen. ;-)
Tino
Hallo,
sorry, ich Stand auf der Leitung!
Ich glaube, dass ich Dich die ganze Zeit falsch verstanden habe.
Du willst nur die Änderungen von diesen 3 erfassen.
Könnte man so machen.
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Bereich As Range, FZelle As Range, strUser As String
 
 strUser = sUserName
 If strUser <> "" Then
    For Each Bereich In Target
     
        With Sheets("Ueberwachung") 'Tabellenname anpassen 
         Set FZelle = .Columns(3).Find(Bereich.Address, , xlValues, 2, 1, 1, False, False, False)
         
         If FZelle Is Nothing Then
          Set FZelle = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
         Else
          Set FZelle = FZelle.Offset(0, -2)
         End If
         
         With FZelle
          .Value = sUserName
          .Offset(0, 1).Value = Format(Now, "hh:mm dd.mm.yy")
          .Offset(0, 2).Value = Bereich.Address
          
          If .Offset(0, 3).Value <> .Offset(0, 4).Value Then
            .Offset(0, 3).Value = .Offset(0, 4).Value
          End If
          
          .Offset(0, 4).Value = Bereich.Value
         End With
        
        End With
    Next Bereich
 End If
 End Sub

Private Function sUserName() As String
 Select Case Environ$("Username")
  Case "Name1": sUserName = "Schulze"
  Case "Name2": sUserName = "Meyer"
  Case "Name3": sUserName = "Hans"
 End Select
End Function


Gruß Tino

AW: jetzt ist der Groschen gefallen. ;-)
Winkler
Genau ;-) Ich versuchs gleich mal...
AW: jetzt ist der Groschen gefallen. ;-)
Winkler
ok. Habe ich drin. Muss der Code dirket zur Tabelle Überwachung oder zur Tabelle wo die Änderungen gemacht werden?
AW: jetzt ist der Groschen gefallen. ;-)
Winkler
Bzw. Ich habe ja in meiner Exceldatei mehrere Register. Wenn ich den Code unter: Diese Arbeitsmappe einfüge, müsste er doch alle Änderungen in allen Registern erfassen, oder?
AW: jetzt ist der Groschen gefallen. ;-)
Tino
Hallo,
ja schon, aber dann musst Du den Tabellennamen bei Adresse mitgeben, sonst macht es keinen Sinn.
zBsp. so.
.... Sh.Name & "!" & Bereich.Address
Gruß Tino

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige