Excel检测并跟踪任何工作表中的（值）更改

我已经设法编写一个代码来检测任何工作表中特定单元格的值变化，但是我一直在努力构build一些能够检测和跟踪范围（值）变化的东西。

例如，如果用户决定复制和粘贴一些数据范围（可以说超过1个单元格），它将不会被macros抓住。 用户select范围，然后手动将值input到每个单元格中，同时范围仍处于选中状态。

我目前的代码是由2个macros构成的，第一次运行时会发生工作表select变化，并将target.value存储到以前的值variables中。 第二个macros在任何时候运行一个工作表变化，并testing目标值是否与前一个不同，如果是的话，它会通知用户发生的变化。

Answer 1

好的，我在这里没有看到任何涵盖整个事情的东西，所以这里是一个粗略的尝试。

它将处理单个或多个单元格的更新（达到一定的限制，你可以设置超出你不想去…）

它不会处理多区域（非连续）的范围更新，但可以扩展到这样做。

你可能应该添加一些error handling。

Private Sub Worksheet_Change(ByVal Target As Range) Dim Where As String, OldValue As Variant, NewValue As Variant Dim r As Long, c As Long Dim rngTrack As Range Application.EnableEvents = False Where = Target.Address NewValue = Target.Value Application.Undo OldValue = Target.Value 'get the previous values Target.Value = NewValue Application.EnableEvents = True Set rngTrack = Sheets("Tracking").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 'multi-cell ranges are different from single-cell ranges If Target.Cells.CountLarge > 1 And Target.Cells.CountLarge < 1000 Then 'multi-cell: treat as arrays For r = 1 To UBound(OldValue, 1) For c = 1 To UBound(OldValue, 2) If OldValue(r, c) <> NewValue(r, c) Then rngTrack.Resize(1, 3).Value = _ Array(Target.Cells(r, c).Address, OldValue(r, c), NewValue(r, c)) Set rngTrack = rngTrack.Offset(1, 0) End If Next c Next r Else 'single-cell: not an array If OldValue <> NewValue Then rngTrack.Resize(1, 3).Value = _ Array(Target.Cells(r, c).Address, OldValue, NewValue) Set rngTrack = rngTrack.Offset(1, 0) End If End If End Sub 

“撤销”部分获取以前的值是从Gary的学生的答案在这里： 使用VBA如何检测工作表中的任何值更改？

Answer 2

这个潜艇将适用于你，但你只是手动在每张表中实现代码。 只需要复制粘贴。 请参阅下面的屏幕截图，用于1张Sheet1

（1）声明一个公共variables。

 Public ChangeTrac As Variant 

（2）在Worksheet_SelectionChange事件中写下面的代码

 Private Sub Worksheet_SelectionChange(ByVal Target As Range) ChangeTrac = Target.Value End Sub 

（3）在Worksheet_Change事件中写下以下代码

 Private Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Target, Cells()) Is Nothing Then If ChangeTrac <> Target.Value Then MsgBox "Value changed to Sheet1 " & Target.Address & " cell." Range(Target.Address).Select End If End If End Sub 

然后通过更改任何单元格中的数据来testing 它会提示是否有任何单元格值更改。