Nutzen Sie unser 
Einfügen in Tabellenblatt (nicht Code-Modul)
Mit diesem Code können Änderungen live in einer Spalte dokumentiert werden. Der Änderungshinweis wird in einer definierten Spalte ausgegeben.
Wenn Sie nun in der Spalte ab der Spalte A5 etwas ändern, wird in der Zelle A2 das Änderungsdatum geschrieben. Für Jede Spalte die geändert wird, ist dieses Makro erneut einzugeben.
Private Sub Worksheet_Change(ByVal Target As Range)
spalte = ActiveSheet.UsedRange.Rows.Count
If Not Application.Intersect(Target, Range("A5:A" & spalte)) Is Nothing Then
ActiveSheet.Range("A2").Value = Now
End If
End Sub
Beispiel:
Wenn hier in der Spalte B bis D etwas geändert wird, wird automatisch in die Spalte A das Wort
"Geändert" geschrieben.Mann kann damit super die Veränderung von Zellen dokumentieren und protokollieren.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Bereich As Range
Dim Z
' Bereich der Wirksamkeit
Set Bereich = Range("B1:D3000")
Application.EnableEvents = False
' überprüfen ob mehr als eine Zelle markiert $A$1:$B$3
' wurde mehere Zellen markiert ist wert größer 0
If InStr(Target.Address, ":") = 0 Then
If Intersect(Target, Bereich) Is Nothing Then GoTo Ende ' Abbruch, wenn Aktion nicht im Zielbereich
Cells(Target.Row, 1) = "Geändert"
Else
' es wurden mehere Zellen markiert
For Each Z In Selection
' überprüfen ob Zelle im vorgegebenen Bereich
If Intersect(Z, Bereich) Is Nothing Then
Else
Cells(Z.Row, 1) = "Geändert"
End If
Next Z
End If
Ende:
Application.EnableEvents = True
End Sub
_______________________
Das ganze gibts auch noch etwas kürzer....
Private Sub Worksheet_Change(ByVal Target As Excel.Range) Select Case Target.Column Case 2 To 4: Cells(Target.Row, 1) = "geändert" Case Else: End Select End Sub
_______________________
Dieser Code ist um die Funktion erweitert, dass nur jede 3. Zeile bei einer Änderung auch mit der
Kennzeichnung geändert versehen wird.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Bereich As Range
Dim Z
' Bereich der Wirksamkeit
Set Bereich = Range("B1:D3000")
Application.EnableEvents = False
' überprüfen ob mehr als eine Zelle markiert $A$1:$B$3
' wurde mehere Zellen markiert ist wert größer 0
If InStr(Target.Address, ":") = 0 Then
If Intersect(Target, Bereich) Is Nothing Then GoTo Ende ' Abbruch, wenn Aktion nicht im Zielbereich
If Target.Row \ 3 = Target.Row / 3 Then Cells(Target.Row, 1) = "Geändert"
Else
' es wurden mehere Zellen markiert
For Each Z In Selection
' überprüfen ob Zelle im vorgegebenen Bereich
If Intersect(Z, Bereich) Is Nothing Then
Else
If Z.Row \ 3 = Z.Row / 3 Then Cells(Z.Row, 1) = "Geändert"
End If
Next Z
End If
Ende:
Application.EnableEvents = True
End Sub
