如何在拖动复制（自动填充）事件期间获取单元格的先前值？

Question

我制作了一个更改日志脚本来存储每个单元格的更改。当我当时更改一个单元格的值时，它工作正常。我对拖动复制或任何事件调用有疑问。我的更改日志有一列用于显示更改之前和更改之后的值。我不知道如何在拖动复制（自动填充）事件期间获取先前的值，因为只有当您释放鼠标按钮时才会进行选择，但释放后新值已经存在。

例如，假设“A”列中有 4 个值

A1=1；

A2=2；

A3=3；

A4=4

如果我将“1”从第一个单元格拖动复制到最后一个单元格。我应该在日志中看到

A2：当前值=1；先前值 = 2；

A3：当前值=1；先前值 = 3；

A4：当前值=1；先前值 = 4；

在自动填充使用复制的值填充单元格之前，如何检测先前值的自动填充区域？

选项显式

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim RangeValues As Variant, r As Long, boolOne As Boolean, TgValue 'the array to keep Target values (before UnDo)
 Dim sh As Worksheet: Set sh = Sheets("Change Log") 'it returns in a sheet named "Change Log"
                                              
 Dim UN As String: UN = Application.UserName
 
 'If Not Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub      'not doing anything if a cell in A:A is changed
 If Not Intersect(ActiveCell, Range("1:3")) Is Nothing Then Exit Sub  'Not doing anything if a cell is changed in first 3 rows
 'If sh.Range("A1") = "" Then sh.Range("A1").Resize(1, 8) = _
 '                                   Array("Date & Time", "User Name", "Changed cell", "From", "To", "Sheet Name", "Column Name")

 Application.ScreenUpdating = False                                     'to optimize the code (make it faster)
 Application.Calculation = xlCalculationManual
 
 If Target.Cells.count > 1 Then
    TgValue = ExtractData(Target)
 Else
    TgValue = Array(Array(Target.Value, Target.Address(0, 0)))  'put the target range in an array (or as a string for a single cell)
    boolOne = True
 End If
 Application.EnableEvents = False                               'avoiding to trigger the change event after Undo
     Application.Undo
     RangeValues = ExtractData(Target)                          'define the RangeValue
     putDataBack TgValue, ActiveSheet                           'put back the changed data
     If boolOne Then Target.Offset(1).Select
 Application.EnableEvents = True

 Dim IdRow As String
 Dim Markup As String
 Dim lsp As String
 Dim columnHeader As String
 For r = 0 To UBound(RangeValues)
    If RangeValues(r)(0) <> TgValue(r)(0) Then
        columnHeader = Cells(4, Range(RangeValues(r)(1)).Column).Value 'headers are on row 4
        lsp = Cells(Range(RangeValues(r)(1)).Row, 5).Value
     '   Markup = Cells(Range(RangeValues(r)(1)).Row, 8).Value
        IdRow = Cells(Range(RangeValues(r)(1)).Row, 1).Value
        sh.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Resize(1, 9).Value = _
                Array(Now, IdRow, UN, Range(RangeValues(r)(1)).Row, RangeValues(r)(0), TgValue(r)(0), lsp, _
                                      Target.Parent.Name, columnHeader) ' if you want to see address of the changed cell leavr only RangeValues(r)(1)
    End If
 Next r
 
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
End Sub

Sub putDataBack(arr, sh As Worksheet)
    Dim i As Long, arrInt, el
    For Each el In arr
        sh.Range(el(1)).Value = el(0)
    Next
End Sub
Function ExtractData(rng As Range) As Variant
    Dim a As Range, arr, count As Long, i As Long
    ReDim arr(rng.Cells.count - 1)
    For Each a In rng.Areas 'creating a jagged array containing the values and the cells address
            For i = 1 To a.Cells.count
                arr(count) = Array(a.Cells(i).Value, a.Cells(i).Address(0, 0)): count = count + 1
            Next
    Next
    ExtractData = arr
End Function

Answer 1

请尝试下一个代码。根据您的需求进行调整。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 'Exit Sub
 Dim RangeValues As Variant, r As Long, boolOne As Boolean, TgValue 'the array to keep Target values (before UnDo)
 Dim sh As Worksheet: Set sh = Sheets("LOG_") 'it returns in a sheet named "LOG_"
                                              'Please, adapt the code, or name a sheet as necessary for the code to work
 Dim UN As String: UN = Application.UserName
 
 'If Not Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub      'not doing anything if a cell in A:A is changed
 'If Not Intersect(ActiveCell, Range("1:2")) Is Nothing Then Exit Sub  'Not doing anything if a cell is changed in first two rows
  'sh.Unprotect "" 'use here your real password, if any
 If sh.Range("A1") = "" Then sh.Range("A1").Resize(1, 6) = _
                                     Array("Time", "User Name", "Changed cell", "From", "To", "Sheet Name")

 Application.ScreenUpdating = False                                     'to optimize the code (make it faster)
 Application.Calculation = xlCalculationManual
 
 If Target.cells.count > 1 Then
    TgValue = ExtractData(Target)
 Else
    TgValue = Array(Array(Target.value, Target.address(0, 0)))  'put the target range in an array (or as a string for a single cell)
    boolOne = True
 End If
 Application.EnableEvents = False                               'avoiding to trigger the change event after UnDo
     Application.Undo
     RangeValues = ExtractData(Target)                          'define the RangeValue
     putDataBack TgValue, ActiveSheet                           'put back the changed data
     If boolOne Then Target.Offset(1).Select
 Application.EnableEvents = True

 Dim columnHeader As String, rowHeader As String
 For r = 0 To UBound(RangeValues)
    If RangeValues(r)(0) <> TgValue(r)(0) Then
        'columnHeader = cells(1, Range(RangeValues(r)(1)).Column).value
        'rowHeader = Range("A" & Range(RangeValues(r)(1)).row).value
        sh.cells(rows.count, 1).End(xlUp).Offset(1, 0).Resize(1, 6).value = _
                Array(Now, UN, RangeValues(r)(1), RangeValues(r)(0), TgValue(r)(0), _
                                      Target.Parent.name, rowHeader, columnHeader)
    End If
 Next r
 
 'sh.Protect ""
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
End Sub

Sub putDataBack(arr, sh As Worksheet)
    Dim i As Long, arrInt, el
    For Each el In arr
        sh.Range(el(1)).value = el(0)
    Next
End Sub
Function ExtractData(rng As Range) As Variant
    Dim a As Range, arr, count As Long, i As Long
    ReDim arr(rng.cells.count - 1)
    For Each a In rng.Areas 'creating a jagged array containing the values and the cells address
            For i = 1 To a.cells.count
                arr(count) = Array(a.cells(i).value, a.cells(i).address(0, 0)): count = count + 1
            Next
    Next
    ExtractData = arr
End Function