仅当单元格值实际不同时才触发 'Worksheet_Change' 事件

Question

我编写代码从 URL 特定页面提取数据。我第一次运行代码将数据从 URL 提取到单元格 C1。

我现在想要在单元格值更改时显示 MsgBox。

例如：

我第一次运行代码 "Happy" 被提取到单元格 C1。
（单元格值发生变化，因此 msgbox "value changed"）
我第二次运行代码然后 "Happy" 也被提取到单元格 C1。
（表示没有变化，注意发生）
第三次我运行代码和 "Sad" 被提取到单元格 C1，
所以在这一点上，我想要一个单元格更改的消息框。

我尝试了下面的代码，但即使在单元格中更改了相同的值，它也会显示 msgbox。

例如 - 单元格包含文本 "Happy"。我在单元格中重写 "Happy" 并按回车键，因此尽管单元格中的文本相同，但它显示单元格的消息框已更改。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("A1:C10")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        ' Display a message when one of the designated cells has been 
        ' changed.
        ' Place your code here.
        MsgBox "Cell " & Target.Address & " has changed."
    End If
End Sub

Answer 1

这样试试：

Public PrevValue

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Value <> PrevValue Then
    MsgBox ("value changed")
    PrevValue = Target.Value
End If
End Sub

以前的值现在存储在全局变量中。当值改变时，它首先检查该值是否与之前的值相同。

编辑：如果每次换不同的cell，也可以用

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
PrevValue = Target.Value
End Sub

设置更改前当前选中单元格的值。

Answer 2

替换：

If Not Application.Intersect(KeyCells, Range(Target.Address))

与：

If Not Application.Intersect(KeyCells, Target)

Answer 3

这使用 Undo 检查单元格的先前值是什么，然后将其与新值进行比较。

这也不是 case-sensitive，所以HAPPY = HAPpy。如果您希望区分大小写，请删除strconv 函数。

请注意，这些过程中的（任何）（包括您的）不会对 多个单元格 立即更改（如粘贴到一系列单元格中）做出正确反应，但您可以添加代码来处理您需要的代码，如注释掉的行所示。

但是对于单细胞，这就可以了：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim KeyCells As Range, vNew, vOld

    If Target.Cells.Count > 1 Then
        MsgBox ("multiple cells changed: " & vbLf & Target.Address)
        'to handle multiple cells changing at omce you'll need to loop like:
        ' dim c as cell
        ' for each c in Target.Cells
        ' ... etc
        Exit Sub
    End If

    Set KeyCells = Range("A1:C10") ' cells to watch

    If Not Application.Intersect(KeyCells, Target) Is Nothing Then

        vNew = Target.Value
        Application.EnableEvents = False
        Application.Undo
        vOld = Target.Value
        Target.Value = vNew
        Application.EnableEvents = True

        'make sure value is different (NOT case sensitive)
        If StrConv(vNew, vbLowerCase) <> StrConv(vOld, vbLowerCase) Then

            'do something here
            MsgBox "Cell " & Target.Address & " changed" & vblf & _
                "From: " & vOld & vblf & _
                "To:   " & vNew

        End If
    End If
End Sub

仅当单元格值实际不同时才触发 'Worksheet_Change' 事件

Fire 'Worksheet_Change' event only when cell value is actually different

excel

events

vba

onchange

更多信息：