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

Detect whether cell value was actually changed by editing

提问by user1615488

Worksheet_Changetriggers when a cell value is changed (which is what I want), but it also triggers when you enter a cell as if to edit it but don't actually change the cell's value (and this is what I don't want to happen).

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

Say I want to add shading to cells whose value was changed. So I code this:

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

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

Now to test my work: Change cell A1 and the cell gets highlighted. That's the desired behaviour. So far so good. Then, double click B1 but don't change the value there and then click C1. You'll notice B1 gets highlighted! And this is not the desired behaviour.

现在测试我的工作：更改单元格 A1 并突出显示该单元格。这就是想要的行为。到现在为止还挺好。然后，双击 B1 但不要更改那里的值，然后单击 C1。您会注意到 B1 被突出显示！这不是理想的行为。

Do I have to go through the methods discussed here of capturing the old value, then compare old to new before highlighting the cell? I certainly hope there's something I'm missing.

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

采纳答案by Jean-Fran?ois Corbett

I suggest automatically maintaining a "mirror copy" of your sheet, in another sheet, for comparison with the changed cell's value.

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

@brettdj and @JohnLBevan essentially propose doing the same thing, but they store cell values in comments or a dictionary, respectively (and +1 for those ideas indeed). My feeling, though, is that it is conceptually much simpler to back up cells in cells, rather than in other objects (especially comments, which you or the user may want to use for other purposes).

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

So, say I have Sheet1whose cells the user may change. I created this other sheet called Sheet1_Mirror(which you could create at Workbook_Openand could set to be hidden if you so desire -- up to you). To start with, the contents of Sheet1_Mirrorwould be identical to that of Sheet1(again, you could enforce this at Workbook_Open).

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

Every time Sheet1's Worksheet_Changeis triggered, the code checks whether the "changed" cell's value in Sheet1is actually different from that in Sheet1_Mirror. If so, it does the action you want and updates the mirror sheet. If not, then nothing.

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

This should put you on the right track:

这应该让你走上正轨：

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

回答by JohnLBevan

Try this code. When you enter a range it stores the original cell values in a dictionary object. When the worksheet change is triggered it compares the stored values with the actuals and highlights any changes.
NB: to improve efficiency reference microsoft scripting runtime & replace the As Objectwith As Scripting.Dictionaryand the CreateObject("Scripting.Dictionary")with New Scripting.Dictionary.

试试这个代码。当您输入一个范围时，它会将原始单元格值存储在字典对象中。当触发工作表更改时，它会将存储的值与实际值进行比较并突出显示任何更改。
NB：提高效率参考Microsoft脚本运行＆替换作为对象与作为的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. any vba code to update cells (even just colour) will stop excel's undo functionality from working! To get around this you can reprogram undo functionality, but it can get quite memory intensive. Sample solutions: http://www.jkp-ads.com/Articles/UndoWithVBA00.asp/ http://www.j-walk.com/ss/excel/tips/tip23.htm

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

回答by brettdj

This code uses Comments to store the prior value (Please note if you do need the comments for other purposes this method will remove them)

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

1. Cells that have no value have colour reset to xlNone
2. An intial value typed into a cell is blue (ColorIndex 34)
3. If the value is changed the cell goes from blue to yellow

1. 没有值的单元格的颜色重置为 xlNone
2. 输入单元格的初始值是蓝色的 (ColorIndex 34)
3. 如果值更改，单元格会从蓝色变为黄色

Normal module - turn display of comments off

普通模块 - 关闭评论显示

    Sub SetCom()
      Application.DisplayCommentIndicator = xlNoIndicator
    End Sub

Sheet code to capture changes

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

    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

回答by GohanP

I know this is an old thread, but I had exactly the same problem like this "Change cell A1 and the cell gets highlighted. That's what I'd expect. Double click B1 but don't change the value there and then click C1. You'll notice B1 gets highlighted! "

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

I didn't wanted to highlight a cell if it was only doubleclicked without value inside.

如果只是双击而没有内部值，我不想突出显示单元格。

I solved in in easy way. Maybe it help somebody in future.

我用简单的方法解决了。也许它可以帮助将来的某个人。

I've just added this on the beggining of the event:

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

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

回答by engrimrantahir

can you send the code? the
If Target.Value = "" Then Exit Sub End If is not solving the problem for me.

你能发送代码吗？在
如果Target.Value =“”然后退出小组结束如果不解决这个问题对我来说。