需要一個宏來檢測單元格值是否從當前值變化

Question

當行中的任何單元格中的值（總是數字格式）發生變化時，我需要宏幫助以通知我（通過將單元格背景顏色更改爲紅色） 。如果單元格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紅色。

任何幫助非常感謝！

Answer 1

這是我最喜歡的檢測在Excel VBA程序變化方式：

1. 創建你看下面的用戶所看到的範圍內隱藏的行範圍內的精確副本。
2. 使用公式將帶有隱藏範圍的用戶範圍與if隱含範圍相加（還隱藏），如果差異不爲0，則將值設置爲1。
3. 在用戶範圍中使用條件格式改變的行的背景色，如果相應變化檢測行（或小區）> 0

我喜歡這個方法什麼：

1. 如果用戶作出改變，然後恢復到原始值，該行「足夠聰明」知道什麼都沒有改變。
2. 任何時候用戶改變某些東西的代碼都是很痛苦的，並且會導致問題。如果按照我所描述的方式設置更改檢測，則代碼僅在表單初始化時觸發。 worksheet_change事件代價昂貴，並且「可能會有效關閉Excel的撤消功能。只要事件過程對工作表進行更改，Excel的撤消堆棧就會被銷燬。」（根據John Walkenbach：Excel 2010 Power Programming）
3. 您可以檢測用戶是否正在遠離頁面導航並警告他們他們的更改將會丟失。

Answer 2

根據你對我在評論中的問題的回答，這段代碼可能會改變。將其粘貼到相關的工作表代碼區域中。爲此，請導航到任何其他工作表，然後導航回原始工作表。

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單元格並將其粘貼到多個單元格中。它不工作當您複製單元塊，做糊（我仍然在做這個）

注意：這不是廣泛的測試。