更改文本当中出现的数字或字母的字体
Sub Macro1()

Dim i&

[a1] = "今天是2010年5月18日，今天要学的是B单元"

For i = 1 To Len([a1])

If Mid([a1], i, 1) Like "[0-9a-zA-Z]" Then [a1].Characters(Start:=i, Length:=1).Font.Name = "黑体"

Next

End Sub

 

 

With Selection.Font
        .Name = "宋体"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With


Selection.Font.name设置字体
Selection.Font.size设置字体大小

 

 

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False  '禁止触发连锁事件
If Not Application.Intersect(Target, [c1:c1000]) Is Nothing Then
On Error Resume Next     '忽略错误继续执行VBA代码,避免出现错误消息
a = Target.Address
For i = 1 To Len(Range(a))    '设置单元内容
    If Mid(Range(a), i, 1) Like "[0-9]" Then Range(a).Characters(Start:=i, Length:=1).Font.ColorIndex = 3   '数字红色
    If Mid(Range(a), i, 1) Like "[0-9]" Then Range(a).Characters(Start:=i, Length:=1).Font.Bold = True    '数字粗体

    If Mid(Range(a), i, 1) <>"[0-9]" Then Range(a).Characters(Start:=i, Length:=1).Font.ColorIndex = 0   '数字黑色
    If Mid(Range(a), i, 1) <> "[0-9]" Then Range(a).Characters(Start:=i, Length:=1).Font.Bold = false    '数字正常
Next
On Error GoTo 0          '恢复正常的错误提示
End If
Application.EnableEvents = True   '允许触发连锁事件
End Sub

 

另：

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False  '禁止触发连锁事件
If Not Application.Intersect(Target, [c1:c1000，A1:A1000]) Is Nothing Then
On Error Resume Next     '忽略错误继续执行VBA代码,避免出现错误消息
a = Target.Address
For i = 1 To Len(Range(a))    '设置单元内容
    If Mid(Range(a), i, 3) = Mid(Cells(ActiveCell.Row, "D").Value, 1, 3) Then Range(a).Characters(Start:=i, Length:=1).Font.ColorIndex = 3 '数字红色
    If Mid(Range(a), i, 3) = Mid(Cells(ActiveCell.Row, "D").Value, 1, 3) Then Range(a).Characters(Start:=i, Length:=1).Font.Bold = True '数字粗体
    If Mid(Range(a), i, 3) <> Mid(Cells(ActiveCell.Row, "D").Value, 1, 3) Then Range(a).Characters(Start:=i, Length:=1).Font.ColorIndex = 0 '数字黑色
    If Mid(Range(a), i, 3) <> Mid(Cells(ActiveCell.Row, "D").Value, 1, 3) Then Range(a).Characters(Start:=i, Length:=1).Font.Bold = False '数字正常

Next
On Error GoTo 0          '恢复正常的错误提示
End If
Application.EnableEvents = True   '允许触发连锁事件
End Sub

Sub ChangeColor()

End Sub