Question

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

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

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

enter image description here

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() 函数。

如果单元格中的计算值基于更改，则更改单元格颜色

1 个答案: