失去焦点的Visual Basic Excel彩色单元格

时间:2014-06-20 16:07:16

标签: excel vba excel-vba colors

我需要在excel中创建一个VBA脚本,当一个值的值比另一个值大至少10%时,将2个单元格着色

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.EnableEvents = False
 If Target.Address = aprx_Lns Then
 If aprx_Lns > aprx2_Lns * 0.1 Then
 aprx_Lns.Interior.Color = Hex(FFFF00)
 aprx2_Lns.Interior.Color = Hex(FFFF00)
 ElseIf aprx_Lns < aprx2_Lns * 0.1 Then
 aprx_Lns.Interior.Color = Hex(FFFF00)
 aprx2_Lns.Interior.Color = Hex(FFFF00)
 End If
 End If
 Application.EnableEvents = True
 End Sub
 Private Sub Worksheet_Change2(ByVal Target As Range)
 Application.EnableEvents = False
 If Target.Address = aprx2_Lns Then
 If aprx_Lns > aprx2_Lns * 0.1 Then
 aprx_Lns.Interior.Color = Hex(FFFF00)
 aprx2_Lns.Interior.Color = Hex(FFFF00)
 ElseIf aprx_Lns < aprx2_Lns * 0.1 Then
 aprx_Lns.Interior.Color = Hex(FFFF00)
 aprx2_Lns.Interior.Color = Hex(FFFF00)
 End If
 End If
 Application.EnableEvents = True
 End Sub

我做错了什么?即使在我使值为if语句为真之后,这两个单元格都没有将颜色改变为所选颜色 我对VBA几乎一无所知,所以任何解释都会很棒。谢谢!

1 个答案:

答案 0 :(得分:0)

按照上面的评论,让我们将逻辑组合到一个事件处理程序中。

此外,最好使用命名范围/单元格,但您需要正确引用它们。除非将其视为显式范围,否则名称本身在VBA中毫无意义。将名称作为字符串传递,如Range("aprx_Lns")等。

注意,此代码仅在您直接更改这两个单元格之一的值时触发。这意味着如果这些单元格包含引用其他单元格的公式,并且其他单元格发生更改,则不会突出显示。

修订版&amp;简化

 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim aprx_Lns As Range
 Dim aprx_Lns2 As Range
 Dim difference As Double
 Dim diffRatio As Double

 Set aprx_Lns = Range("aprx_Lns")    '## Modify as needed
 Set aprx2_Lns = Range("aprx2_Lns")   '## Modify as needed

 Application.EnableEvents = False
 If Target.Address = aprx_Lns.Address Or Target.Address = aprx2_Lns.Address Then


    difference = Abs(aprx_Lns) / Abs(aprx2_Lns)
    '## compute the absolute difference as a ratio
    diffRatio = Abs(1 - difference)

    If diffRatio >= 0.1 Then
    '### if the cell values differ by +/- 10%, then highlight them
         aprx_Lns.Interior.Color = 65535 'vbYellow
         aprx2_Lns.Interior.Color = 65535 'vbYellow
    Else
    '### otherwise, unhighlight them:
        aprx_Lns.Interior.Color = xlNone
        aprx2_Lns.Interior.Color = xlNone
    End If
End If
Application.EnableEvents = True

End Sub