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

来源:转载

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代码会自动运行,这将导致无法撤消或恢复。

分享给朋友:
您可能感兴趣的文章:
随机阅读: