如果单元格中的计算值发生变化，则更改单元格颜色

Posted 2023-04-13

【中文标题】如果单元格中的计算值发生变化，则更改单元格颜色

【英文标题】：Changing cell colour if calculated value in the cell changes based

【发布时间】：2021-04-17 16:02:58

【问题描述】：

我在同一个电子表格中有 2 个工作表，第 2 个工作表的日期基于第一个工作表和不同的 vlookup。现在，我知道如果单元格中的计算值发生变化，如何更改单元格颜色：

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

当我在第二个工作表中使用这个VBA 并更改第一个工作表时，第二个工作表中的单元格颜色不会改变。当我手动更新第一个工作表时，我希望第二个工作表中带有公式的单元格改变它们的颜色。 是否可以？谢谢！

enter image description here

enter image description here

【问题讨论】：

您能否添加一个实际示例、一些示例数据、一些屏幕截图以及有关公式的一些信息（它们与第一个工作表上的单元格是否位于相同的单元格中）？您可以随时edit您的问题。

Worksheet_Change() 仅在您手动更改单元格时发生，而不是计算值更改。

这听起来更像是conditional formatting 的工作。

【参考方案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() 函数。

【讨论】：

您好，感谢您的回答，我已经像您发布的那样更改了 VBA 代码，但是当我更改第一个工作表时，第二个工作表的颜色仍然没有变化......即使我更改了第一个工作表，没有颜色变化..

您好！我已经解决了第二个问题：我更改了第一个工作表，没有颜色变化。但第一个问题仍然存在。因为第二个单元格数据与第一个工作表上的单元格不在同一个单元格中......你能告诉我我该怎么做吗？

你可以在第二张表中用row,column表达式找到单元格地址，例如$C$10，C列，第10行，像这样：Worksheets("Name_Of_2nd_Worksheet").Range(" $C$10").Interior.Color = RGB(255, 0, 0)

但另一个问题是每个工作表中都有成千上万的数据。我不能一个一个地检查每个单元格的数据......在这段时间里，我了解到计算可以读取公式的结果，我们可以按照这个想法......？无论如何，感谢您的帮助和回答！

打扰一下，您的意思是我需要将所有“strWorksheetName1”更改为我的工作表名称，例如“Sheet 1”吗？如果情况像我重新编辑问题中的图片，我是否应该像这样更改代码： Dim Sheet1 As String, $A$1 As String Dim A1 As Range, A1:B24 As Object 我很抱歉我的无知，并且非常感谢您的帮助。