11

Worksheet_Change当单元格值更改时触发(这是我想要的),但它也会在您输入单元格时触发,好像要编辑它但实际上并没有更改单元格的值(这是我不希望发生的事情) )。

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

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

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

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

4

5 回答 5

4

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

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

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

每次触发Sheet1's时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
于 2012-08-22T07:52:44.087 回答
2

试试这个代码。当您输入范围时,它将原始单元格值存储在字典对象中。当触发工作表更改时,它会将存储的值与实际值进行比较并突出显示任何更改。
注意:为了提高效率,请参考 microsoft 脚本运行时并将As Object替换为As Scripting.Dictionary并将CreateObject("Scripting.Dictionary")替换为New 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

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

于 2012-08-22T00:07:33.550 回答
2

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

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

在此处输入图像描述

普通模块 - 关闭评论显示

    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
于 2012-08-22T00:08:54.390 回答
1

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

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

我以简单的方式解决了。也许它会在未来帮助某人。

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

 If Target.Value = "" Then
      Exit Sub
 End If
于 2015-12-03T14:38:51.143 回答
0

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

如何在 Excel VBA 中获取已更改单元格的旧值?

于 2021-03-31T15:02:59.883 回答