如果通过另一个单元格中的公式链接到单元格，是否可以有条件地格式化单元格？

Question

在第一页上，我在A列中有描述，而在B列中有值。在第二页，我在A到F列中有公式，我根据其中的描述手动填写了第一页B列中的值列A是。如果相关单元格已在第二页的公式中使用，我想突出显示第一页B列中的单元格。尽可能使用条件格式，否则使用宏。

我希望能够快速查看B列中的单元格是否已经添加到另一张纸上的公式中，这样我就不会意外地将该值包含两次。

  Sheet One               Sheet Two
     A     B     C           A     B     C
1  salt    3            1       =B1+B4
2  base    3            2
3  base    4            3
4  salt    1            4             =B2+B3
5  base    4            5

我希望能够自动突出显示另一个功能中已经存在的单元格，而不必手动进行操作以减少错误机会。在上面的示例中，单元格B1到B4将被突出显示，因为它们已在公式中使用，而B5仍将保持正常，因为尚未使用

Answer 1

VBA条件格式化专长。数组和范围并集

功能

• Find Method（SO）
• 单元格属性
• 父母财产
• 公式属性
• 调整大小方法
• InStr函数
• 替换功能
• 联盟方法

代码

Sub CompareColumnWithRange()

  Const cStrTgtWs As Variant = 1        ' Target Worksheet Name/Index
  Const cStrSrcWs As Variant = 2        ' Source Worksheet Name/Index
  Const cLngTgtFirst As Long = 1        ' Target First Row
  Const cLngSrcFirst As Long = 1        ' Source First Row
  Const cStrTgtColumn As Variant = "B"  ' Target Column Letter/Number
  Const cStrSrcRange As String = "A:F"  ' Source Columns Range
  Const cColor As Long = 255            ' Formatting Color

  Dim rngTgt As Range                   ' Target Range
  Dim rngU As Range                     ' Target Union Range
  Dim vntSrc As Variant                 ' Source Array
  Dim i As Long                         ' Source Array Row Counter
  Dim j As Integer                      ' Source Array Column Counter
  Dim k As Long                         ' Target Range Row Counter

  With Worksheets(cStrSrcWs).Range(cStrSrcRange)
    ' Check if sheet is empty (No data).
    If .Find("*", .Cells(.Rows.Count, .Columns.Count), -4123, , 1) _
        Is Nothing Then Exit Sub
    ' Paste Source Range's formulas into Source Array. Since the previous
    ' With statement refers to a range, the Parent property has to be used
    ' to 'aquire sheet level'.
    vntSrc = .Parent.Range(.Parent.Cells(cLngSrcFirst, .Column), _
        .Parent.Cells(.Cells.Find("*", , , , , 2).Row, _
        .Columns.Count - .Column + 1)).Formula
  End With

'  ' Print contents of vntSrc to Immediate window.
'  For i = 1 To UBound(vntSrc)
'    For j = 1 To UBound(vntSrc, 2)
'      Debug.Print vntSrc(i, j)
'    Next
'  Next

  ' Target Column vs Source Array
  With Worksheets(cStrTgtWs)
    ' Determine the Target Range (1 column).
    Set rngTgt = .Cells(cLngTgtFirst, cStrTgtColumn).Resize( _
        .Cells(.Rows.Count, cStrTgtColumn).End(xlUp).Row - cLngTgtFirst + 1)
    ' Loop through Target Range (1 column)
    For k = cLngTgtFirst To .Cells(.Rows.Count, cStrTgtColumn).End(xlUp).Row
      ' Loop through Source Array rows.
      For i = 1 To UBound(vntSrc)
        ' Loop through Source Array columns.
        For j = 1 To UBound(vntSrc, 2)
          ' Search for Target Range's cell address in current value
          ' of Source Array i.e. remove the $ signs in both, and add
          ' sheet name for Target Range.
          If InStr(1, Replace(vntSrc(i, j), "$", ""), .Name & "!" _
              & Replace(.Cells(k, cStrTgtColumn).Address, "$", "")) <> 0 Then
            If Not rngU Is Nothing Then ' Add cells to existing range.
              Set rngU = Union(rngU, .Cells(k, cStrTgtColumn))
             Else ' Add cells to non-existing range. Runs only the first time.
              Set rngU = .Cells(k, cStrTgtColumn)
            End If
            Exit For  ' If a value has been found, stop searching for more.
          End If
        Next
      Next
    Next
  End With

  ' Apply formatting to all 'collected' cells in Target Union Range in one go.
  If Not rngU Is Nothing Then
    rngU.Interior.Color = cColor
    Set rngU = Nothing
  End If

  Set rngTgt = Nothing

End Sub