|
Hallo,
auf die Schnelle ist mir nur diese Lösung eingefallen:
Option Explicit
Private Const iOffset As Integer = 2 'Offset der Spalte, in die der vorherige Wert geschrieben wird
Private Const sRange As String = "C4:C6" 'Range, deren Werte bei Änderungen verlegt werden
Dim sValues() As String
Private Sub Worksheet_Change(ByVal Target As Range)
'Quick & Dirty
On Error Resume Next
Dim c As Range, s As String
For Each c In Target.Cells
s = getValueFromArray(c.address)
If Not s = vbNullString Then
c.Offset(0, iOffset).Value = s
End If
Next c
On Error GoTo 0
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Target, Range(sRange))
If rng Is Nothing Then
Exit Sub
End If
Dim c As Range, l As Long
ReDim sValues(Target.Cells.Count - 1, 1)
For Each c In Target.Cells
sValues(l, 0) = c.address
sValues(l, 1) = c.Value
l = l + 1
Next c
End Sub
Private Function getValueFromArray(ByVal address As String) As String
Dim l As Long
For l = 0 To UBound(sValues(), 1)
If sValues(l, 0) = address Then
getValueFromArray = sValues(l, 1)
Exit Function
End If
Next l
End Function
Den Code in das Codeobjekt des entsprechenden Worksheets packen und mal probieren.
Viele Grüße
|