VBA 如果单元格字体颜色 = "x"则从单元格偏移 = "y"工作表 Chang 事件

Question

每次有满足特定条件的更改时，我都使用了以下代码的类似版本来时间戳。我不知道为什么下面的代码不起作用。

如果单元格字体颜色等于 14(深蓝色(，那么它将向右移动 5 列并将单元格值更改为"ROOF"。

Private Sub Worksheet_Colour(ByVal Target As Range)
Dim ptInt As Range
Dim rangeCell As Range
Dim sCell As Range
Dim cCell As Integer
Set ptInt = Intersect(Target, Range("D12:D70"))
If Not ptInt Is Nothing Then
For Each rangeCell In ptInt
cCell = rangeCell.Font.ColorIndex
If cCell = 14 Then
Set sCell = rangeCell.Offset(0, 5)
sCell.Value = "ROOF"
End If
Next
End If
End Sub

编辑：

我设法使代码做我想做的事，但是，它仅在单元格值更改时触发，是否可以在更改字体时触发它？

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rInt As Range
Dim rCell As Range
Dim tCell As Range
Set rInt = Intersect(Target, Range("G12:G116"))
If Not rInt Is Nothing Then
For Each rCell In rInt
If Target.Font.ColorIndex = 23 Then
Set tCell = rCell.Offset(0, 7)
'If IsEmpty(tCell) Then
tCell = "ROOF"
'End If
End If
Next
End If
End Sub

编辑2：

我将宏从Worksheet_Change更改为Worksheet_Calculate。这样，每次重新计算工作表时，它都会更新。正是我需要的。谢谢大家的帮助！

Private Sub Worksheet_Calculate()
Dim rInt As Range
Dim rCell As Range
Dim tCell As Range
Set rInt = Range("G12:G116,V12:V116")
If Not rInt Is Nothing Then
For Each rCell In rInt
If rCell.Font.ColorIndex = 23 Then
Set tCell = rCell.Offset(0, 7)
tCell = "ROOF"
ElseIf rCell.Font.ColorIndex = 14 Then
Set tCell = rCell.Offset(0, 7)
tCell = "ROOF2"
Else
Set tCell = rCell.Offset(0, 7)
tCell = ""
End If
Next
End If
End Sub

Answer 1

如果您确实希望使用工作表事件完成此操作，以下是使用SelectionChange事件的可能解决方案。Excel 没有仅在发生格式更改时触发的事件。每当单击任何单元格时，此宏将检查整个单元格范围(G12：G116(。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rCell As Range
Dim checkRange As Range
Set checkRange = Range("G12:G116")
For Each rCell In checkRange
If rCell.Font.ColorIndex = 23 Then ' tailor this to your needs
rCell.Offset(0, 7).value = "ROOF"
End if
Next
End Sub

备注：在更改字体颜色后单击另一个单元格之前，此宏不会运行。

Answer 2

固定代码为：

Private Sub Worksheet_Colour(ByVal Target As Range)
Dim ptInt As Range
Dim rangeCell As Range
Dim sCell As Range
Dim cCell As Integer
Set ptInt = Intersect(Target, Range("D12:D70"))
If Not ptInt Is Nothing Then
For Each rangeCell In ptInt
cCell = rangeCell.Font.Color
If cCell = 6299648 Then
Set sCell = rangeCell.Offset(0, 5)
sCell.Value = "ROOF"
End If
Next
End If
End Sub

问题出在线路rangeCell.Font.ColorIndex我用rangeCell.Font.Color行替换了它，这使得深蓝色值6299648。

要查看不同颜色的不同值，请使用MsgBox(rangeCell.Font.Color)。