需要一个宏来检测单元格值是否从当前值更改 [英] Need a macro to detect if cell value changes from current value

查看:124
本文介绍了需要一个宏来检测单元格值是否从当前值更改的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

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

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中的数字将手动输入或通过行的复制和粘贴,并且不会有任何公式。同样,如果单元格F4:AN4中的任何值都更改,我希望单元格E4更改为红色背景,依此类推,图表中的每一行。并不是所有的行总是有一个值,所以我会寻找从到任何#,或从一个#到另一个#,或从任何#到的更改。理想情况下,这将是一个不必手动运行的事件宏。

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.

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

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

但是,这个宏似乎运行,无论单元格中的数字是否改变,只要我按Enter键,它将E3突出显示为红色。

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.

任何帮助都非常感谢!

推荐答案

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

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

它按预期工作当您在单元格中键入值时。当您复制1个单元格并将其粘贴到多个单元格中时,它也可以工作。

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't work when you copy a block of cells and do a paste (I am still working on this)

https://i.stack.imgur.com/N1goi.pngalt =在此输入图像说明>

注意:这没有被广泛的测试。

NOTE: This is not extensively tested.

这篇关于需要一个宏来检测单元格值是否从当前值更改的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆