需要一个宏来检测单元格值是否从当前值更改 [英] Need a macro to detect if cell value changes from current value
问题描述
当需要帮助时,通知我(通过将单元格背景颜色更改为红色),当行中的任何单元格中的值(总是数字格式)发生更改时。我想让单元格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屋!