如果單元格中的計算值發生變化，則更改單元格顏色

Question

我在同一個電子表格中有 2 個工作表，第二個工作表日期基於具有各種vlookup的第一個工作表。 現在，我知道如果單元格中的計算值發生變化，如何更改單元格顏色：

Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Interior.Color = 3
End Sub

當我在第二個工作表中使用這個VBA並更改第一個工作表時，第二個工作表中的單元格顏色不會改變。 當我手動更新第一個工作表時，我希望第二個工作表中帶有公式的單元格改變它們的顏色。 可能嗎？ 謝謝！

在此處輸入圖像描述

在此處輸入圖像描述

Answer 1

我猜一個解決方案：因為您在第二個工作表中的 VBA 代碼將不起作用，因為我們沒有用戶觸發。 因此，在您的第一個工作表中，我們可以執行以下操作：

Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Interior.Color = RGB(255, 0, 0)
    Worksheets("Name_Of_2nd_Worksheet").Range(Target.Address()).Interior.Color = _
        RGB(255, 0, 0)
End Sub

當您在第一個工作表中更改某些內容時，第二個工作表將更改填充顏色。

---

第二種解決方案更復雜但更接近您的要求。 它在第二張工作表中使用 VBA Worksheet_Calculate()事件，請先從第一張工作表中刪除所有 VBA，如下所示：

Private Function getActualUsedRange(ByVal strVLookUp)
  Set getActualUsedRange = Range("A1").Resize(Cells.Find(what:=strVLookUp, SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row, _
    Cells.Find(what:=strVLookUp, SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column)
End Function

'
' change color of all cells with formulas containing some string:
'
' strVLookUp: vlookup
' strFirstAddress: address of first cell, like $C$5
' objCell: range object of 1 cell
' objRange: range object of cells with formulas
' lBackColor: long for color index
'
Private Sub Worksheet_Calculate()

  Dim strVLookUp As String, strFirstAddress As String
  Dim objCell As Object, objRange As Object
  Dim lBackColor As Long

  ' search this string in formulas in 2nd Worksheet:
  strVLookUp = "vlookup"

  ' change back color as you want:
  lBackColor = RGB(255, 150, 0)

  ' get whole range with formulas involving "vlookup":
  Set objRange = getActualUsedRange(strVLookUp)
  
  ' if we find a range, loop over it:
  If Not objRange Is Nothing Then
  
    Set objCell = objRange.Find(strVLookUp, LookIn:=xlFormulas)
    
    If Not objCell Is Nothing Then
    
      strFirstAddress = objCell.Address
      
      Do
        objCell.Interior.Color = lBackColor
        Set objCell = objRange.FindNext(objCell)
      Loop While Not objCell Is Nothing And objCell.Address <> strFirstAddress
      
    End If

    ' free memory:
    Set objCell = Nothing
    Set objRange = Nothing
    '
  End If
'
End Sub

這是基於以下事實：在第二個工作表中，某些單元格具有如下公式：=vlookup("MyValue", ...)，您引用了 vlookup() function。