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

时间:2012-05-04 00:46:22

标签: excel-vba vba excel

我需要帮助宏来通知我(通过将单元格背景颜色更改为红色),当值(总是数字格式)在行中的任何单元格中发生更改时。如果单元格F3:AN3中的任何值从其当前值更改,我希望单元格E3的背景变为红色。

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

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

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

然而,无论单元格中的数字是否发生变化,这个宏似乎都会运行,只要按下输入它就会将E3高亮显示为红色。

非常感谢任何帮助!

2 个答案:

答案 0 :(得分:3)

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

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

<强>快照

按预期工作当您在单元格中键入值时。当您复制1个Cell并将其粘贴到多个单元格中时,它也可以工作。当你复制一个单元格块并进行粘贴时,它工作(我还在努力)

enter image description here

注意:这未经过广泛测试。

答案 1 :(得分:2)

以下是我最喜欢的检测Excel VBA应用程序更改的方法:

  1. 在用户看到的范围之下的隐藏行中创建您正在观看的范围的精确副本。
  2. 在下面添加另一部分(也是隐藏的),公式用隐藏范围减去用户范围,if语句将值设置为1,如果差异不是0,则
  3. 如果相应的更改检测行(或单元格)>&gt;,则在用户范围内使用条件格式更改行的背景颜色。 0
  4. 我喜欢这种方法:

    1. 如果用户进行了更改,然后还原为原始值,则该行“足够智能”,以便知道没有任何更改。
    2. 当用户改变某些东西时运行的代码很痛苦并且可能导致问题。如果按照我描述的方式设置更改检测,则代码仅在初始化工作表时触发。 worksheet_change事件很昂贵,并且 “可以有效地关闭Excel的撤销功能。只要事件过程对工作表进行更改,就会销毁Excel的撤销堆栈。” (每个John Walkenbach:Excel 2010 Power Programming
    3. 您可以检测用户是否正在离开该页面,并警告他们他们的更改将会丢失。