实现效果如下:
代码如下:
Sub MyCharacters() Dim arr, s$, i&, L&, n& s = InputBox("请输入改变的字符", "提示") '需要改变格式的字符串 n = Len(s) '变量s的长度 If n = 0 Then: Exit Sub Application.ScreenUpdating = False arr = Range("a1:a" & Range("a" & Rows.Count).End(xlUp).Row) For i = 1 To UBound(arr) L = InStr(1, arr(i, 1), s, vbTextCompare) '查找变量s在arr(i,1)中首次出现的位置,不区分字母大小写 Do While L '如果l不为0,也就是存在s的话那么…… With Cells(i, 1).Characters(L, n).Font .Size = 15 '15号字体 .FontStyle = "加粗" .Color = -16776961 '红色 End With L = InStr(L + n, arr(i, 1), s, vbTextCompare) '寻找变量s下一个出现的位置 Loop Next Application.ScreenUpdating = True MsgBox "处理完毕!" End Sub