excel運(yùn)用VBA完成類似條件格式改變字體字號(hào)的效果

Excel中的條件格式可以非常直觀地顯示某些特定的數(shù)據(jù)，功能十分強(qiáng)大。但條件格式也有一些限制，例如無(wú)法通過(guò)條件格式設(shè)置字體和字號(hào)。如果要根據(jù)條件來(lái)改變單元格中字體或字號(hào)，可以用VBA來(lái)實(shí)現(xiàn)。下面的VBA代碼將指定區(qū)域（H2:H500）中大于5000而小于10000的數(shù)值設(shè)置為“黑體”、“16”，而將指定區(qū)域中其他單元格的字體和字號(hào)設(shè)置為“宋體”、“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="">
.Font.Name = "黑體"
.Font.Size = 16
Else
.Font.Name = "宋體"
.Font.Size = 11
End If
End With
Next
Application.ScreenUpdating = True
End Sub

使用方法是：按Alt +F11，打開(kāi)VBA編輯器，在“工程”窗口中選擇需要設(shè)置的工作表，在代碼窗口中粘貼上述代碼。然后返回到Excel工作表界面，按Alt+F8打開(kāi)“宏”對(duì)話框，選擇上述代碼第一行的宏名稱運(yùn)行即可。

當(dāng)區(qū)域中的內(nèi)容更改后，上述代碼還不能實(shí)現(xiàn)自動(dòng)設(shè)置字體字號(hào)的功能。要實(shí)現(xiàn)這種類似條件格式的效果，可以加上下面的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")
'設(shè)置dRng為T(mén)arget的從屬區(qū)域，僅對(duì)本工作表中的引用有效
Set dRng = Range(Target.Dependents.Address)
'如果從屬區(qū)域包含在指定區(qū)域中
If Not Intersect(dRng, Rng) Is Nothing Then
For Each rCell In Intersect(dRng, Rng)
SetFont rCell
Next
End If
'如果直接在指定區(qū)域中更改
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="">
.Font.Name = "黑體"
.Font.Size = 16
Else
.Font.Name = "宋體"
.Font.Size = 11
End If
End With
End Function

這樣當(dāng)區(qū)域中的數(shù)值更改或區(qū)域中的公式重新計(jì)算后，會(huì)按照條件自動(dòng)設(shè)置字體和字號(hào)。

說(shuō)明：

1.代碼中用到Range.Dependents屬性，該屬性不能追蹤遠(yuǎn)程引用，因而僅當(dāng)指定區(qū)域中的公式中包含本工作表的引用時(shí)有效。

2.添加上述VBA代碼后，當(dāng)指定區(qū)域中的內(nèi)容更改后VBA代碼會(huì)自動(dòng)運(yùn)行，這將導(dǎo)致無(wú)法撤消或恢復(fù)。