用VBA实现类似条件格式改变字体字号的效果

作者：未知 文章来源：www.excel123.cn 点击数： 229 更新时间：2010-12-10 16:39:44

    Excel中的条件格式可以非常直观地显示某些特定的数据，功能十分强大。但条件格式也有一些限制，例如无法通过条件格式设置字体和字号。如果要根据条件来改变单元格中字体或字号，可以用VBA来实现。下面的VBA代码将指定区域（H2:H500）中大于5000而小于10000的数值设置为“黑体”、“16”，而将指定区域中其他单元格的字体和字号设置为“宋体”、“11”。

Sub ConditionalFont()
Dim rCell As Range
Dim Rng As Range
Set Rng = Range("H2:H500")
Application.ScreenUpdating = False
For Each rCell In Rng
  With rCell
    If .Value > 5000 And .Value < 10000 Then
       .Font.Name = "黑体"
       .Font.Size = 16
    Else
       .Font.Name = "宋体"
       .Font.Size = 11
    End If
  End With
Next
Application.ScreenUpdating = True
End Sub

    使用方法是：按Alt +F11，打开VBA编辑器，在“工程”窗口中选择需要设置的工作表，在代码窗口中粘贴上述代码。然后返回到Excel工作表界面，按Alt+F8打开“宏”对话框，选择上述代码第一行的宏名称运行即可。

    当区域中的内容更改后，上述代码还不能实现自动设置字体字号的功能。要实现这种类似条件格式的效果，可以加上下面的VBA代码：

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim rCell As Range
Dim Rng As Range
Dim dRng As Range
Set Rng = Range("H2:H500")
'设置dRng为Target的从属区域，仅对本工作表中的引用有效
Set dRng = Range(Target.Dependents.Address)
'如果从属区域包含在指定区域中
If Not Intersect(dRng, Rng) Is Nothing Then
For Each rCell In Intersect(dRng, Rng)
 SetFont rCell
Next
End If
'如果直接在指定区域中更改
If Union(Target, Rng).Address = Rng.Address Then
For Each rCell In Target
  SetFont rCell
Next
End If
End Sub

Function SetFont(rRange As Range)
With rRange
    If .Value > 5000 And .Value < 10000 Then
      .Font.Name = "黑体"
      .Font.Size = 16
    Else
      .Font.Name = "宋体"
      .Font.Size = 11
    End If
End With
End Function

    这样当区域中的数值更改或区域中的公式重新计算后，会按照条件自动设置字体和字号。

    说明：

    1.代码中用到Range.Dependents属性，该属性不能追踪远程引用，因而仅当指定区域中的公式中包含本工作表的引用时有效。

    2.添加上述VBA代码后，当指定区域中的内容更改后VBA代码会自动运行，这将导致无法撤消或恢复。