Datum/Autor für Eingabe mit "Historie" (vba)
18.11.2008 17:52:05
Lukas
in meiner Unwissenheit wurde ich gebeten, folgendes umzusetzen:
In A5 wird ein Wert eingegeben, in A7 und A8 sollen einmal Autor und einmal Datum der Änderung notiert werden. Jetzt wird in A5 ein neuer Wert eingetragen, der alte Wert aus A5 soll inklusive Autor und Datum 2 Zeilen nach unten rutschen, u.s.w., sodass am Ende alle Werte mit ihrem Autor und Datum noch vorhanden sind. (Analog soll das für noch 4 weitere Spalten so funktionieren.)
Durch probieren und suchen habe ich folgendes hinbekommen:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vntTempArray As Variant
Dim strTargetAddress As String
Dim objCell As Range
If Not Intersect(Target, Range("A5:T5")) Is Nothing Then
vntTempArray = Target.Value2
strTargetAddress = Target.Address
Application.EnableEvents = False
Application.Undo
For Each objCell In Target
If Not Intersect(objCell, Range("A5:T5")) Is Nothing Then
objCell.Insert Shift:=xlShiftDown
objCell.Cut Destination:=objCell.Offset(1)
End If
Next
Range(strTargetAddress).Value2 = vntTempArray
Application.EnableEvents = True
End If
If Target.Column = 1 And Target.Cells.Count = 1 Then
Cells(Target.Row, 3) = Environ("USERNAME")
Cells(Target.Row, 4) = Now()
End If
If Target.Column = 5 And Target.Cells.Count = 1 Then
Cells(Target.Row, 7) = Environ("USERNAME")
Cells(Target.Row, 8) = Now()
End If
If Target.Column = 9 And Target.Cells.Count = 1 Then
Cells(Target.Row, 11) = Environ("USERNAME")
Cells(Target.Row, 12) = Now()
End If
If Target.Column = 13 And Target.Cells.Count = 1 Then
Cells(Target.Row, 15) = Environ("USERNAME")
Cells(Target.Row, 16) = Now()
End If
If Target.Column = 17 And Target.Cells.Count = 1 Then
Cells(Target.Row, 19) = Environ("USERNAME")
Cells(Target.Row, 20) = Now()
End If
End Sub
Das Problem ist jetzt, dass er mir den Autor und das Datum in die 7. Zeile schreibt anstatt der 5., wodurch es immer wieder überschrieben wird und nicht mit nach unten rutscht.
Also im Endeffekt sollen Datum und Autor in der 5. Zeile erscheinen, probieren hat auch nichts gebracht :-/
Beste Grüße und Dank im Voraus
Lukas