通过编辑检测单元格值是否实际更改答案

【问题标题】：Detect whether cell value was actually changed by editing通过编辑检测单元格值是否实际更改
【发布时间】：2021-03-31 23:02:59
【问题描述】：

Worksheet_Change 在更改单元格值时触发（这是我想要的），但它也会在您输入单元格时触发，好像要编辑它但实际上并没有更改单元格的值（这就是我不想发生）。

假设我想为值已更改的单元格添加阴影。所以我编写了这个代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Interior.ColorIndex = 36
End Sub

现在测试我的工作：更改单元格 A1，单元格将突出显示。这是期望的行为。到目前为止，一切都很好。然后，双击 B1 但不要更改那里的值，然后单击 C1。您会注意到 B1 被突出显示！这不是理想的行为。

我是否必须通过此处讨论的捕获旧值的方法，然后在突出显示单元格之前将旧值与新值进行比较？我当然希望我缺少一些东西。

【问题讨论】：

是的，你这样做:)。 Change 事件旨在捕获对单元格的编辑 - 而不是测量来自该编辑的数据 - 因此将编辑结果与先前状态进行比较的测试超出了 Change 事件的直接范围
@user - 你认为这看起来很奇怪是正确的。我想这个问题只能通过更具体（和复杂）的方法来回答，例如对类似问题的其他回答是：“相对于何时改变”？如果这是您的目标，Gimp 的建议很好 - 跟踪特定会话中的所有更改。但是，如果您想跟踪（例如）给定会话中的多个更改，则需要使用另一种方法。 Worksheet_change 只是将事件作为“钩子”提供给您 - 您必须在此基础上构建（不幸的是有时很多）以满足您的特定需求。
您考虑过使用Track Changes 功能吗？
stackoverflow.com/questions/4668410/…

标签： vba excel

【解决方案1】：

我建议在另一张工作表中自动维护工作表的“镜像副本”，以便与更改后的单元格的值进行比较。

@brettdj 和@JohnLBevan 本质上建议做同样的事情，但它们分别将单元格值存储在 cmets 或字典中（并且确实为这些想法 +1）。不过，我的感觉是，在单元格中备份单元格，而不是在其他对象（尤其是 cmets，您或用户可能希望将其用于其他目的）中备份单元格在概念上要简单得多。

所以，假设我有Sheet1，用户可以更改其单元格。我创建了另一个名为Sheet1_Mirror 的工作表（您可以在Workbook_Open 创建，如果您愿意，可以将其设置为隐藏 - 由您决定）。首先，Sheet1_Mirror 的内容与Sheet1 的内容相同（同样，您可以在Workbook_Open 强制执行此操作）。

每次触发Sheet1的Worksheet_Change时，代码都会检查Sheet1中“更改”单元格的值是否实际上与Sheet1_Mirror中的值不同。如果是这样，它会执行您想要的操作并更新镜像表。如果没有，那就什么都没有。

这应该会让你走上正轨：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    For Each r In Target.Cells
        'Has the value actually changed?
        If r.Value <> Sheet1_Mirror.Range(r.Address).Value Then
            'Yes it has. Do whatever needs to be done.
            MsgBox "Value of cell " & r.Address & " was changed. " & vbCrLf _
                & "Was: " & vbTab & Sheet1_Mirror.Range(r.Address).Value & vbCrLf _
                & "Is now: " & vbTab & r.Value
            'Mirror this new value.
            Sheet1_Mirror.Range(r.Address).Value = r.Value
        Else
            'It hasn't really changed. Do nothing.
        End If
    Next
End Sub

【讨论】：

谢谢，让-弗朗索瓦。我最终选择了这个解决方案。
我试了一下，第 5 行出现错误，如果 r.Value Sheet1_Mirror... Runtime 424, Object required..
也试过了：Sheets("Sheet1_Mirror").Range(r.Address).Value 没有成功
我测试了这段代码，它可以工作。您是否尝试在调试模式下单步执行代码？这将帮助您识别错误。 r 什么都没有？你有一张名为Sheet1_Mirror 的表格吗？只有你能发现...

【解决方案2】：

此代码使用 Comments 来存储先前值（请注意，如果您确实需要 cmets 用于其他目的，此方法将删除它们）

没有值的单元格将颜色重置为xlNone
在单元格中输入的初始值是蓝色 (ColorIndex 34)
如果更改值，单元格将从蓝色变为黄色

普通模块 - 关闭 cmets 的显示

    Sub SetCom()
      Application.DisplayCommentIndicator = xlNoIndicator
    End Sub

用于捕获更改的工作表代码

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng1 As Range
    Dim shCmt As Comment
    For Each rng1 In Target.Cells

    If Len(rng1.Value) = 0 Then
    rng1.Interior.ColorIndex = xlNone
    On Error Resume Next
    rng1.Comment.Delete
    On Error GoTo 0
    Else

    On Error Resume Next
    Set shCmt = rng1.Comment
    On Error GoTo 0

    If shCmt Is Nothing Then
        Set shCmt = rng1.AddComment
        shCmt.Text Text:=CStr(rng1.Value)
         rng1.Interior.ColorIndex = 34
    Else
        If shCmt.Text <> rng1.Value Then
            rng1.Interior.ColorIndex = 36
            shCmt.Text Text:=CStr(rng1.Value)
        End If
    End If
    End If
    Next
    End Sub

【讨论】：

【解决方案3】：

试试这个代码。当您输入范围时，它将原始单元格值存储在字典对象中。当触发工作表更改时，它会将存储的值与实际值进行比较并突出显示任何更改。
注意：为了提高效率，请参考微软脚本运行时并将 As Object 替换为 As Scripting.Dictionary 和 CreateObject("Scripting.Dictionary")使用 新的 Scripting.Dictionary。

Option Explicit

Private previousRange As Object 'reference microsoft scripting runtime & use scripting.dictionary for better performance
                                'I've gone with late binding to avoid references from confusing the example


Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cell As Variant

    For Each cell In Target
        If previousRange.Exists(cell.Address) Then
            If previousRange.Item(cell.Address) <> cell.FormulaR1C1 Then
                cell.Interior.ColorIndex = 36
            End If
        End If
    Next

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim cell As Variant

    Set previousRange = Nothing 'not really needed but I like to kill off old references
    Set previousRange = CreateObject("Scripting.Dictionary")

    For Each cell In Target.Cells
        previousRange.Add cell.Address, cell.FormulaR1C1
    Next

End Sub

ps。任何更新单元格的 vba 代码（甚至只是颜色）都会阻止 excel 的撤消功能工作！要解决这个问题，您可以重新编程撤消功能，但它可能会占用大量内存。示例解决方案：http://www.jkp-ads.com/Articles/UndoWithVBA00.asp/http://www.j-walk.com/ss/excel/tips/tip23.htm

【讨论】：

【解决方案4】：

我知道这是一个旧线程，但我遇到了完全相同的问题，例如“更改单元格 A1 并且单元格被突出显示。这就是我所期望的。双击 B1 但不要更改那里的值，然后单击 C1。您会注意到 B1 被突出显示！"

我不想突出显示一个单元格，如果它只是被双击而里面没有值。

我以简单的方式解决了。也许它可以帮助将来的人。

我刚刚在活动开始时添加了这个：

 If Target.Value = "" Then
      Exit Sub
 End If

【讨论】：

【解决方案5】：

我发现这个其他线程提供了捕获旧值的方法，因此您可以将它与“新”值进行比较，如果是，那么就让它什么都不做。

How do I get the old value of a changed cell in Excel VBA?

【讨论】：