|
Sub 斜杠字体()
On Error Resume Next
Dim matches, match
For Each cell In Selection
cell.Font.ColorIndex = 1
With CreateObject("VBSCRIPT.REGEXP")
.Pattern = "/.*?/"
.Global = True
If .test(cell.Value) Then
Set matches = .Execute(cell.Value)
For Each match In matches
' With cell.Characters(Start:=InStr(cell.Text, match.Value), Length:=Len(match.Value)) '包含斜杠
With cell.Characters(Start:=InStr(cell.Text, match.Value) + 1, Length:=Len(match.Value) - 2) '不包含斜杠
.Font.ColorIndex = 3
.Font.Name = "楷体"
End With
Next match
End If
End With
Next cell
End Sub |
评分
-
1
查看全部评分
-
|