Excel 检测并跟踪任何工作表中的(值)变化 [英] Excel detecting and keeping track of (value) changes in any worksheet

问题描述

我设法编写了一个代码来检测任何工作表中特定单元格的值变化，但我一直在努力构建检测和跟踪范围(值)变化的东西.

I've managed to write a code that detects value changes of particular cells in any worksheet, but I've struggled to construct something that detects and keeps track of ranged (value) changes.

例如，如果用户决定复制和粘贴某个范围的数据(比如说超过 1 个单元格)，它不会被宏捕获.用户选择一个范围，然后在仍然选择范围时手动将值输入到每个单元格中也是如此.

For example, if a user decides to copy and paste some range of data (lets say more than 1 cell), it will not get caught by the macro. Same goes for a user selecting a range and then manually entering values into each cell while range is still selected.

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

My current code is constructed of 2 macros, the first runs anytime a worksheet selection change occurs and it stores the target.value into a previous value variable. The second macro runs anytime a worksheet change occurs and it tests if the targeted value is different than the previous one, if so it then notifies the user of the change that had occurred.

推荐答案

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

OK I don't really see anything here which covers the whole thing, so here's a rough attempt.

它将处理单个或多个单元格更新(您可以设置一些限制，超出您不想去的范围......)

It will handle single or multi-cell updates (up to some limit you can set beyond which you don't want to go...)

它不会处理多区域(非连续)范围更新，但可以扩展为这样做.

It will not handle multi-area (non-contiguous) range updates, but could be extended to do so.

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

You likely should add some error handling also.

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's Student's answer here:使用 VBA如何检测工作表中的任何值何时发生变化?

"Undo" part to get the previous values is from Gary's Student's answer here: Using VBA how do I detect when any value in a worksheet changes?

这篇关于Excel 检测并跟踪任何工作表中的(值)变化的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！