提取公式中的参数并加粗斜体或者加下划线
Function ExtractFormula(rng As Range) As Variant()
Dim myArr() As Variant
' 获取单元格中的公式文本
Dim formulaText As String
formulaText = rng.Formula
' 提取所有带有绝对引用符号的 Range 参数
Dim pattern As String
pattern = "\$?[A-Z]+\${0,1}\d+(:\$?[A-Z]+\${0,1}\d+\${0,1})?" ' 匹配带有绝对引用符号的 Range 引用
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
With regex
.Global = True
.pattern = pattern
End With
Dim match As Object
Set match = regex.Execute(formulaText)
' 输出所有带有绝对引用符号的 Range 参数
ReDim myArr(0 To match.Count - 1)
Dim i As Integer
For i = 0 To match.Count - 1
Debug.Print match(i)
myArr(i) = match.Item(i)
Next i
ExtractFormula = myArr
End Function
Sub FormatMatchingText()
Dim match() As Variant
match = ExtractFormula(Range("a1")) ' 将你想要匹配的文本逐个添加到该数组中
Range("b1").NumberFormat = "@"
Range("b1").Value = Range("a1").Formula
Dim rangeToSearch As Range
'Set rangeToSearch = ActiveSheet.UsedRange ' 搜索整个工作表
Set rangeToSearch = Range("b1")
For Each cell In rangeToSearch
For i = 0 To UBound(match)
If InStr(cell.Value, match(i)) > 0 Then
cell.Characters(Start:=InStr(cell.Value, match(i)), Length:=Len(match(i))).Font.FontStyle = "Bold Italic"
cell.Characters(Start:=InStr(cell.Value, match(i)), Length:=Len(match(i))).Font.Underline = xlUnderlineStyleSingle
End If
Next i
Next cell
End Sub
只是拿一个单元格示例,效果如图: