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

我已经成功地编写了一个代码来检测任何工作表中特定单元格的值变化，但我一直在努力构建一个能够检测并跟踪范围（值）变化的东西

例如，如果用户决定复制和粘贴某个范围的数据（比如说多个单元格），则宏不会捕获该数据。同样，用户选择一个范围，然后在仍然选择范围的情况下手动将值输入每个单元格

---

我当前的代码由两个宏组成，第一个宏在工作表选择发生更改时运行，它将target.value存储到以前的值变量中。第二个宏在工作表发生更改时运行，它测试目标值是否与前一个不同，如果目标值与前一个不同，它将通知用户已发生的更改。

此子项适用于您，但您只需在每个工作表中手动实现代码。只需要复制粘贴。请参见下面的屏幕截图，该截图适用于1张

Sheet1

（1） 声明一个公共变量

Public ChangeTrac As Variant

（2） 在工作表\u选择更改事件中写入以下代码

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

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

（3） 在工作表\u更改事件中写入以下代码

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

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

Private子工作表\u更改（ByVal目标作为范围）
如果不是Application.Intersect（Target，Cells（））则什么都不是
如果更改Trac目标值，则
MsgBox“值更改为Sheet1”&目标地址和单元格。”
范围（目标地址）。选择
如果结束
如果结束
端接头

---

然后通过更改任何单元格中的数据进行测试。如果任何单元格值发生更改，它将提示。

好的，我在这里没有看到任何涵盖整个内容的内容，所以这里是一个粗略的尝试

它将处理单个或多个单元格的更新（最高可设置的限制，超过该限制，您不想去…）

它不会处理多区域（非连续）范围更新，但可以扩展以进行更新

您可能还应该添加一些错误处理

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

Private子工作表\u更改（ByVal目标作为范围）
Dim Where As String，OldValue As Variant，NewValue As Variant
变暗r为长，c为长
变暗rngTrack As范围
Application.EnableEvents=False
其中=Target.Address
NewValue=Target.Value
应用程序。撤消
OldValue=Target.Value'获取以前的值
Target.Value=NewValue
Application.EnableEvents=True
设置rngTrack=Sheets（“跟踪”）。单元格（Rows.Count，1）。结束（xlUp）。偏移（1，0）
“多单元格范围不同于单单元格范围
如果Target.Cells.CountLarge>1且Target.Cells.CountLarge<1000，则
'多单元：视为数组
对于r=1到UBound（旧值，1）
对于c=1到UBound（旧值，2）
如果OldValue（r，c）NewValue（r，c），那么
rngTrack.Resize（1，3）。值=_
数组（目标.单元格（r，c）.地址，旧值（r，c），新值（r，c））
设置rngTrack=rngTrack.Offset（1,0）
如果结束
下一个c
下一个r
其他的
'单单元格：不是数组
如果OldValue NewValue，则
rngTrack.Resize（1，3）。值=_
数组（目标.单元格（r，c）.地址，旧值，新值）
设置rngTrack=rngTrack.Offset（1,0）
如果结束
如果结束
端接头

获取之前值的“撤消”部分来自Gary的学生回答：

---

你应该编辑你的帖子，添加你的代码或你迄今为止尝试过的内容，否则你可能得不到帮助……看看你问题下方右侧的“相关”问题——这里有很多以前类似的问题（有答案），它实际上会给我一个错误。（运行时错误'13'类型不匹配）。我遇到的问题是检测发生了什么。什么变成了我的问题，所以我必须将以前的值存储在某个地方。excel在将值存储到范围中时似乎存在问题。如果我复制代码并拍摄我要搜索的内容，是否会有所帮助？最好共享一个示例工作簿。只需将示例文件上传到google drive并在此处共享链接。正如您所见，此代码跟踪单个单元格的更改。但是，如果我决定一次更改“一个区域”或多个单元格（例如通过复制粘贴，…），它不会检测并记录这些内容。代码如下：Dim PreviousValue Public Sub sheet_change（ByVal Target As Range）logDate=Format（Now（），“dd/mmm/yyyy”）logTime=Format（Now（），“hh:mm:ss”）在出现错误时，如果ActiveSheet.UsedRange.Address=“$A$1”和Range（“A1”）=”，则继续下一步，如果Target.Value PreviousValue然后Sheets（“Audit”）.Cells（65000，1）。End（xlUp）。Offset（1，0）。Value=logDate&&&logTime&:“&Environment（“用户名”）&&uChanged Cells”&Target.Address&“from”&PreviousValue&&to”&Target.Value&“in”&ActiveSheet.Name结束If结束If结束子语句用于您的答案。这正是我要找的。有没有办法使这项工作在更高的层次上进行？例如，工作簿级别？非常感谢你。谨致问候，Domenth在工作簿级别有一个

Workbook\u SheetChange

事件。您可以在那里使用非常类似的代码：只需要添加工作表名称的跟踪，并排除任何不希望跟踪的工作表（例如跟踪工作表本身）。是否有任何方法可以通过application.undo代码执行时发生的选择返回。例如，如果我将“5”写入一个空白单元格，然后单击另一个单元格，（application.undo）会将我的选择返回到我更改值的单元格，也会返回到我写入5的单元格。有没有办法防止这种情况发生？我提前感谢你们分享的智慧。种类Regards在执行撤消之前，存储当前选择：然后可以在撤消之后恢复它