Question

我设法编写了一个代码，用于检测任何工作表中特定单元格的值变化，但我一直在努力构建能够检测并跟踪范围（值）变化的内容。

例如，如果用户决定复制并粘贴某些数据范围（比如超过1个单元格），则不会被宏捕获。同样适用于用户选择范围，然后在仍然选择范围时手动将值输入每个单元格。

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

Answer 1

好的，我在这里看不到任何涵盖整个事情的内容，所以这是一次艰难的尝试。

它将处理单个或多个单元格更新（达到您可以设置的某个限制，超出您不想要的范围......）

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

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

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的学生答案： Using VBA how do I detect when any value in a worksheet changes?

Answer 2

此子程序适用于您，但您只需手动在每个工作表中实现代码。只需要复制粘贴。请参阅以下屏幕截图，其中包含1张Sheet1

（1）声明一个公共变量。

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

然后通过更改任何单元格中的数据进行测试。它会提示是否有任何单元格值被更改。

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

2 个答案: