VBA - Änderungen protokollieren wenn Zelle nicht leer

[felippo]

Hallo liebes Clever-Excel-Nutzer,

ich habe seit ein paar Tagen ein Problem und komme leider nicht mehr wirklich weiter, da ich auch recht neu im Umgang mit VBA bin.

Ich möchte Änderungen auf einem Excel-Sheet protokollieren und habe dafür bei herber das folgende Makro gefunden und etwas modifiziert:

Code:

Public varValue As Variant
Public strAddress As String
Private Sub Worksheet_Active()
If Selection.Value = "" Then
    GoTo Weiter
End Sub
Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim intRow As Integer
Dim intDate As Long
For Each c In Target
    If c.Value <> varValue Or IsEmpty(c) Then
        With Worksheets("Protokoll")
            intRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Cells(intRow, 1).Value = c.Row
            .Cells(intRow, 2).Value = c.Column
            .Cells(intRow, 5).Value = c.Value
            .Cells(intRow, 6).Value = Date
            .Cells(intRow, 7).Value = Time
            .Cells(intRow, 8).Value = Environ("username")
            varValue = CStr(c.Value)
        End With
    End If
Next
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
varValue = ActiveCell.Value
strAddress = ActiveCell.Address
Weiter:
End Sub

Wie ihr vermutlich seht, werden Änderungen im Sheet "Protokoll" protokolliert. Das funktioniert auch gut, allerdings wird es immer wieder vorkommen, dass Nutzer eine ganze Reihe von Zellen markieren und den Inhalt entfernen (z. B. Zeile 5 bis 15 markieren und Entf drücken, obwohl nur in den Zeilen 5 und 15 Inhalt ist). In diesen Fällen werden Änderungen für alles protokolliert. Ich möchte aber nur ein Protokoll, wenn der Inhalt einer Zelle gelöscht wird oder wenn in eine leere Zelle etwas beschrieben wird.

Daher dachte ich, man kommt mit dem o.g. Makro aus, wenn es vorher prüft, ob die Zelle leer ist - falls dem so ist und diese auch nicht befüllt wird, wird kein Protokoll geführt.

Wo liegt der Fehler? 

Viele Grüße

[UweD]

Hallo

du könntest die Änderung auf nur eine Zelle begrenzen.

Das Prüfen auf "Leer" würde ich nicht tun.
Wenn vorher was drin stand und jetzt gelöscht wird, möchtest du doch sicher auch protokollieren.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fehler
    Const APPNAME = "Worksheet_Change"
   
    Dim c As Range
    Dim intRow As Integer
    Dim intDate As Long
    Dim RNG As Range
    Dim AlterWert As String
   
    Set RNG = Rows("5:15")
   
    If Not Intersect(Target, RNG) Is Nothing Then ' nur auslösen, wenn in diesem Bereich geändert wird
        If Target.Count > 1 Then
            MsgBox "Nur einzeln ändern"
            With Application
                .EnableEvents = False
                .Undo
                .EnableEvents = True
            End With
            Exit Sub
        End If
   
        For Each c In Intersect(Target, RNG) 'nur für den Bereich (also nicht, wenn mehr Zellen selectiert sind
           
            'Wert vorher ermitteln
            With Application
                .EnableEvents = False
                .Undo
                AlterWert = Target
                .Undo
                .EnableEvents = True
                          
            End With
           
            If c.Value <> AlterWert Then
                With Worksheets("Protokoll")
                    intRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(intRow, 1).Value = c.Row
                    .Cells(intRow, 2).Value = c.Column
                    .Cells(intRow, 5).Value = c.Value
                    .Cells(intRow, 6).Value = Date
                    .Cells(intRow, 7).Value = Time
                    .Cells(intRow, 8).Value = Environ("username")
                   
                    'bei Bedarf den Alten Wert
                    .Cells(intRow, 10).Value = AlterWert
                End With
            End If
        Next
    End If
   
    '*** Fehlerbehandlung
    Err.Clear
Fehler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear

End Sub

LG UweD

[felippo]

Hallo Uwe,

das ist auf jeden Fall auch eine gangbare Lösung, wäre ich nicht drauf gekommen.

Vielen Dank dafür!

Erste Tests sehen vielversprechend aus und ich denke die "Einschränkung" nur eine Zelle nach der anderen zu bearbeiten ist vertretbar. Nun werde ich mal schauen, wie ich ein komplettes Arbeitsblatt regelmäßig upgedated bekomme 

LG
Felix