3

当行中任何单元格中的值（始终为数字格式）发生变化时，我需要宏的帮助来通知我（通过将单元格背景颜色更改为红色）。如果单元格 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

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

任何帮助深表感谢！

4

2 回答 2

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 个单元格并将其粘贴到多个单元格中时，它也可以工作。当您复制一块单元格并进行粘贴时它不起作用（我仍在努力）

在此处输入图像描述

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

于 2012-05-04T08:36:49.073 回答
3

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

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

我喜欢这种方法的地方：

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