vba 需要一个宏来检测单元格值是否从当前值改变

Need a macro to detect if cell value changes from current value

提问by dave1414

I need help with an macro to notify me (by changing a cell background color to red), when the value (always number format) changes in any cells in the row. I want the background of cell E3 to change to red, if any of the values in cells F3:AN3 change from their current values.

当行中的任何单元格中的值（始终为数字格式）更改时，我需要宏的帮助来通知我（通过将单元格背景颜色更改为红色）。如果单元格 F3:AN3 中的任何值从其当前值更改，我希望单元格 E3 的背景更改为红色。

The numbers in cells F3:AN3 will be entered manually or thru copy and paste of the row, and there won't be any formulas. Likewise, if any values in cells F4:AN4 are changed, I would like cell E4 to change to a red background, and so on for each of the rows in the chart. Not all rows will always have a value, so I would be looking for changes from "" to any #, or from one # to another #, or from any # to "". Ideally this would be an event macro that does not have to be run manually.

单元格 F3:AN3 中的数字将手动输入或通过该行的复制和粘贴输入，并且不会有任何公式。同样，如果单元格 F4:AN4 中的任何值发生更改，我希望单元格 E4 更改为红色背景，对于图表中的每一行，依此类推。并非所有行都总是有一个值，所以我会寻找从“”到任何#，或从一个#到另一个#，或从任何#到“”的变化。理想情况下，这将是一个不必手动运行的事件宏。

The following is the code I've started working with:

以下是我开始使用的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F3:AN3")) Is Nothing Then KeyCellsChanged
End Sub


Private Sub KeyCellsChanged()

   Dim Cell As Object
     For Each Cell In Range("E3")
    Cell.Interior.ColorIndex = 3

   Next Cell

End Sub

However, this macro seems to run regardless of whether the number in the cell is changed, as long as I press enter it highlight E3 as red.

但是，无论单元格中的数字是否更改，这个宏似乎都会运行，只要我按回车键，它就会将 E3 突出显示为红色。

Any help is much appreciated!

任何帮助深表感谢！

回答by Jon Crowell

Here is my favorite way to detect changes in an Excel VBA app:

这是我最喜欢的检测 Excel VBA 应用程序更改的方法：

1. Create an exact copy of the range you're watching in hidden rows below the range the user sees.
2. Add another section below that (also hidden) with formulas subtracting the user range with the hidden range with an if statement that sets the value to 1 if the difference is anything but 0.
3. Use conditional formatting in the user range that changes the background color of the row if the corresponding change-detection row (or cell) is > 0.

1. 在用户看到的范围下方的隐藏行中创建您正在观看的范围的精确副本。
2. 在其下方添加另一部分（也是隐藏的），使用公式减去用户范围和隐藏范围，并使用 if 语句将值设置为 1，如果差异不是 0。
3. 如果相应的更改检测行（或单元格）> 0，则在更改行的背景颜色的用户范围中使用条件格式。

What I like about this approach:

我喜欢这种方法的地方：

1. If a user makes a change and then reverts back to the original value, the row is "smart enough" to know that nothing has changed.
2. Code that runs any time a user changes something is a pain and can lead to problems. If you set up your change detection the way I'm describing, your code only fires when the sheet is initialized. The worksheet_change event is expensive, and also "may effectively turn off Excel's Undo feature. Excel's Undo stack is destroyed whenever an event procedure makes a change to the worksheet."(per John Walkenbach: Excel 2010 Power Programming)
3. You can detect if the user is navigating away from the page and warn them that their changes will be lost.

1. 如果用户进行了更改，然后恢复到原始值，则该行“足够聪明”，知道没有任何更改。
2. 在用户更改某些内容时运行的代码很痛苦，并且可能导致问题。如果您按照我描述的方式设置更改检测，则您的代码仅在工作表初始化时触发。worksheet_change 事件代价高昂，而且“可能会有效地关闭 Excel 的撤消功能。每当事件过程对工作表进行更改时，Excel 的撤消堆栈就会被破坏。” （根据约翰沃肯巴赫：Excel 2010 Power Programming）
3. 您可以检测用户是否离开页面并警告他们所做的更改将丢失。

回答by Siddharth Rout

Depending on your answer to my question in the comments, this code may change. Paste this in the relevant Worksheet code area. For this to work, navigate to any other sheet and then navigate back to the original sheet.

根据您在评论中对我的问题的回答，此代码可能会更改。将此粘贴到相关的工作表代码区域中。为此，请导航到任何其他工作表，然后导航回原始工作表。

Option Explicit

Dim PrevVal As Variant

Private Sub Worksheet_Activate()
    If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
        PrevVal = Selection.Value
    Else
        PrevVal = Selection
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo ExitGraceFully
    If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
        PrevVal = Selection.Value
    Else
        PrevVal = Selection
    End If
ExitGraceFully:
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.WorksheetFunction.CountA(Target) = 0 Then Exit Sub

    Dim aCell As Range, i As Long, j As Long

    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns("F:AN")) Is Nothing Then
        If Target.Rows.Count = 1 And Target.Columns.Count >= 1 Then
            Range("E" & Target.Row).Interior.ColorIndex = 3
        ElseIf Target.Rows.Count > 1 And Target.Columns.Count = 1 Then
            i = 1
            For Each aCell In Target
                If aCell.Value <> PrevVal(i, 1) Then
                    Range("E" & aCell.Row).Interior.ColorIndex = 3
                End If
                i = i + 1
            Next
        ElseIf Target.Rows.Count > 1 And Target.Columns.Count > 1 Then
            Dim pRow As Long

            i = 1: j = 1

            pRow = Target.Cells(1, 1).Row

            For Each aCell In Target
                If aCell.Row <> pRow Then
                    i = i + 1: pRow = aCell.Row
                    j = 1
                End If

                If aCell.Value <> PrevVal(i, j) Then
                    Range("E" & aCell.Row).Interior.ColorIndex = 3
                End If
                j = j + 1
            Next
        End If
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    Resume LetsContinue
End Sub

SNAPSHOTS

快照

It works as expected When you type a value in the cell. It also works when you copy 1 Cell and paste it in multiple cells. It doesn'twork when you copy a block of cells and do a paste (I am still working on this)

当您在单元格中键入一个值时，它会按预期工作。当您复制 1 个单元格并将其粘贴到多个单元格中时，它也适用。当你复制一块单元格并粘贴时它不起作用（我仍在研究这个）

NOTE: This is not extensively tested.

注意：这没有经过广泛测试。