公式更新单元格数据时，如何让VBA自动更新单元格背景色？

原VBA代码仅在直接修改目标单元格（如示例中的D1）并回车时，才会将单元格背景色设置为其内容对应的十六进制颜色。但当通过修改A1/B1/C1这类公式依赖单元格来改变D1的十六进制码时，无法自动触发背景色更新——原因是Worksheet_Change事件仅监听单元格本身的手动修改，公式单元格的内容变化不会触发该事件。

以下是两种可行的解决方案：

方案1：使用Worksheet_Calculate事件 #

公式单元格内容更新时会触发工作表的计算事件，通过监听该事件来更新背景色：

Private Sub Worksheet_Calculate()
    On Error GoTo bm_Safe_Exit
    Application.EnableEvents = False
    Dim rng As Range, clr As String
    ' 遍历所有包含公式的单元格，可根据实际范围调整（比如只取D列）
    For Each rng In Me.Range("D:D").SpecialCells(xlCellTypeFormulas)
        If Len(rng.Value2) = 6 Then
            clr = rng.Value2
            rng.Interior.Color = _
              RGB(Application.Hex2Dec(Left(clr, 2)), _
                  Application.Hex2Dec(Mid(clr, 3, 2)), _
                  Application.Hex2Dec(Right(clr, 2)))
        End If
    Next rng

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

方案2：修改Worksheet_Change事件监听依赖列 #

直接监听A/B/C列的修改，自动更新对应行的D列单元格背景色，这种方式更高效：

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo bm_Safe_Exit
    Application.EnableEvents = False
    Dim rng As Range, clr As String, targetCell As Range
    
    ' 检查修改的单元格是否在A、B、C列范围内
    If Not Intersect(Target, Me.Range("A:C")) Is Nothing Then
        For Each rng In Intersect(Target, Me.Range("A:C"))
            ' 获取对应行的D列单元格
            Set targetCell = Me.Cells(rng.Row, "D")
            If Len(targetCell.Value2) = 6 Then
                clr = targetCell.Value2
                targetCell.Interior.Color = _
                  RGB(Application.Hex2Dec(Left(clr, 2)), _
                      Application.Hex2Dec(Mid(clr, 3, 2)), _
                      Application.Hex2Dec(Right(clr, 2)))
            End If
        Next rng
    End If

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

说明 #

• 方案1适合公式分布较广的场景，每次工作表计算都会触发，但如果数据量较大可能会有性能损耗；
• 方案2仅在修改指定依赖列时触发，针对性更强，性能更优。

内容的提问来源于stack exchange，提问作者Fortanow