MS Excel工作表更改事件 - 保留旧的单元格值的记录对新价值

Question

我是新来这个论坛，但已经建立在近一由于我目前的角色VBA要求几个月我的编码经验。今天的问题已经看到我通过许多网站（以及我的Excel VBA for Dummies书籍）进行搜索，但我还没有完全确定它。

我试图在Excel中的审计跟踪文件对于我们公司风险登记。这个想法是，一旦建立了风险登记簿，任何变更都将创建一个审计线索（在单独的选项卡上），其中显示旧记录和新记录。

我已经写了使用更改事件处理程序的代码。我希望我的宏火每次有一个变化的时间和执行以下操作：
请对“审计（什么用户刚刚覆盖）旧的单元格值的参考
2.跳转跟踪”标签，贴全风险记录的两个副本 - 每个风险战绩占据17列
在这17列的第一个副本的一行数据，制定出哪一列是被编辑过并更换该小区与旧单元格值（在步骤1中捕获）
4.插入时间戳
5.有条件格式化突出显示已更改的记录[此功能在代码中不需要，因为我已在电子表格中设置它]
6.跳回到用户刚刚制作的单元他们的编辑（在'风险注册'选项卡上）

我已经管理步骤1,2和4-7，但我有问题获取代码以将“旧单元格值”输入到“审计”中的正确位置跟踪器“选项卡。如果我手动定义要粘贴的单元格区域，我可以在那里找到它，但似乎无法使其变为动态，以便它会自动识别用户正在更改的字段，并确保在审核中修改相同的字段落后。

真的很感激任何见解，为什么“PasteRange.Value =工作表（”风险登记册“）（oldValuePaste“）”行不工作

我的代码如下范围。”：

Dim oldValue As Variant 
    Dim LastRow As Long 
    Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
     Application.ScreenUpdating = False 
      If Not Intersect(Target, Range("b13:r13")) Is Nothing Then 
       oldValue = Target.Value 
      End If 
     Application.ScreenUpdating = True 
    End Sub 

    Private Sub Worksheet_Change(ByVal Target As Range) 
     Application.ScreenUpdating = False 

    If Not Intersect(Target, Range("b13:r14")) Is Nothing Then 
     If Target.Value <> oldValue Then 
      'MsgBox "You just changed " & Target.Address 
      Cells(65, 5).Value = oldValue  'this cell is a named range called: OldValuePaste 
      Cells(66, 5).Value = Target.row  'this cell is a named range called: OldValueRowNumber 
      Cells(67, 5).Value = Target.Column 'this cell is a named range called: OldValueColumnNumber 

      Range(Cells(Target.row, 2), Cells(Target.row, 18)).Copy 
      'Cells(70, 2).PasteSpecial xlPasteValues 

      Call Paste_on_AuditSheet 
      Sheets("Risk Register").Activate 
      Target.Select 
      Application.CutCopyMode = False 

     End If 
    End If 

Application.ScreenUpdating = True 
End Sub 

_____________________________________________________________________________________________________ 

Sub Paste_on_AuditSheet() 
Application.ScreenUpdating = False 
Dim LastRow As Long 
Dim ColNum As Long 
Dim PasteRange As Range 
ColNum = OldValueColumnNumber 

    Sheets("Audit trail").Select 
    'MsgBox "Activated " & ActiveSheet.Name 

     'Find the last used row in a Column: column B in this example 
     With ActiveSheet 
      LastRow = .Cells(.Rows.Count, "B").End(xlUp).row 
     End With 

    Set PasteRange = Cells(LastRow, ColNum) 

'The following two lines bring in the new data and paste into old record and new record sections: 
     Cells(LastRow + 1, 2).PasteSpecial xlPasteValues 
     Cells(LastRow + 1, 20).PasteSpecial xlPasteValues 

'Then this line goes back over the piece just pasted in and changes one cell in "old record" section to what it was prior to the edit: 
     'PasteRange.Value = Worksheets("Risk Register").Range("oldValuePaste") 
'Above line of code is not working, but can get it to do the right thing using this code (although it's not dynamic): 
     Range("E3").Value = Worksheets("Risk Register").Range("oldValuePaste") 

'Add a time stamp: 
    Cells(LastRow + 1, 1) = Now 

Application.ScreenUpdating = True 
End Sub 

最后一点 - 尽管我反复使用Application.ScreenUpdating的命令，我仍然得到一些屏幕闪烁 - 任何想法，为什么？

在此先感谢您的帮助！

Answer 1

在审查您的代码时，我看到了一些我认为不会按照您的设想工作的事情，并且还认识到您的代码可以变得更简单，只需从Worksheet_Change事件中调用即可。

所以下面的重构的代码，让我知道，如果你有问题：

Private Sub Worksheet_Change(ByVal Target As Range) 

If Not Intersect(Target, Range("b13:r14")) Is Nothing Then 

    'get oldValue 
    Dim sNewVal As String, sOldVal As String 
    sNewValue = Target.Value 'store current or "new" value since this is what is stored after the cell change takes place 
    With Application 
     .EnableEvents = False 'turns off event firing so the code will not go into endless loop 
     .Undo 'undo the change (to store old value in next line) 
    End With 
    sOldValue = Target.Value 'store old value 
    Target.Value = sNewValue 'reset new value 

    Dim lCol As Long 
    lCol = Target.Column 'which column of data was changed 

    'assumes columns A-Q are 17 columns 
    Me.Range(Me.Cells(Target.Row, 1), Me.Cells(Target.Row, 17)).Copy 

    With Sheets("Audit Trail") 

     Dim lRow As Long 
     lRow = .Range("B" & .Rows.Count).End(xlUp).Offset(1).Row 

     .Range("B" & lRow).PasteSpecial xlPasteValues 
     .Range("B" & lRow + 1).PasteSpecial xlPasteValues 
     .Range("A" & lRow).Value = Now 

     .Cells(lRow, lCol + 1).Value = sOldValue 'store old value in first pasted line ... add 1 since starting from column B 

    End With 

End If 

Application.EnableEvents = True 

End Sub