我有以下代码,它提示输入字符串,然后在选定的单元格中突出显示它的所有实例。
我如何修改它以便在一次操作中提示并突出显示多个不同的单词?
Sub HighlightStrings()
Dim xHStr As String, xStrTmp As String
Dim xHStrLen As Long, xCount As Long, I As Long
Dim xCell As Range
Dim xArr
On Error Resume Next
xHStr = Application.InputBox("What is the string to highlight:", "KuTools For Excel", , , , , , 2)
If TypeName(xHStr) <> "String" Then Exit Sub
Application.ScreenUpdating = False
xHStrLen = Len(xHStr)
For Each xCell In Selection
xArr = Split(xCell.Value, xHStr)
xCount = UBound(xArr)
If xCount > 0 Then
xStrTmp = ""
For I = 0 To xCount - 1
xStrTmp = xStrTmp & xArr(I)
xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 3
xStrTmp = xStrTmp & xHStr
Next
End If
Next
Application.ScreenUpdating = True
End Sub
答案1
此修改后的代码将允许您输入多个以空格分隔的单词,并且所有单词都将突出显示:
Option Explicit
'v0.1.1
Sub HighlightStrings()
Dim xHStr As String, xStrTmp As String
Dim xHStrLen As Long, xCount As Long, I As Long
Dim xCell As Range
Dim xArr
On Error Resume Next
xHStr = Application.InputBox("What are the words to highlight:", "Word Higlighter")
If TypeName(xHStr) <> "String" Then Exit Sub
Application.ScreenUpdating = False
For Each xCell In Selection
Dim varWord As Variant
For Each varWord In Split(xHStr, Space$(1))
xHStrLen = Len(varWord)
xArr = Split(xCell.Value, varWord)
xCount = UBound(xArr)
If xCount > 0 Then
xStrTmp = ""
For I = 0 To xCount - 1
xStrTmp = xStrTmp & xArr(I)
xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 3
xStrTmp = xStrTmp & varWord
Next
End If
Next varWord
Next xCell
Application.ScreenUpdating = True
End Sub
它使用Split()
函数将输入的单词分离到数组中,然后使用额外的循环循环遍历选择中每个单元格的所有单词。
请注意,代码区分大小写。可以通过更改此语句将其修改为不区分大小写
xArr = Split(xCell.Value, varWord)
对此
xArr = Split(UCase$(xCell.Value), UCase$(varWord))
答案2
此修改版本的 VBA 代码将突出显示选定范围内的特定单词。
创建一个命令按钮并输入此代码。
Private Sub CommandButton1_Click()
Dim strSearch As String
Dim UserRange As Range
Dim arySearch As Variant
Dim searchRng As Range
Dim cel As Range
Dim i As Long, ii As Long
Set UserRange = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select", Type:=8)
strSearch = InputBox("Please Enter Text To Highlight As A Comma Delimited List (Abc, Xyz) it's Case Sensative :", "Highlight Text")
If strSearch = "" Then Exit Sub
arySearch = Split(strSearch, ",")
For Each cel In UserRange
With cel
For ii = LBound(arySearch) To UBound(arySearch)
i = InStr(cel.Value, arySearch(ii))
If i > 0 Then
.Characters(i, Len(arySearch(ii))).Font.ColorIndex = 3
End If
Next ii
End With
Next cel
End Sub
怎么运行的:
- 单击命令按钮。
- 通过选择数据范围来响应第一个输入框并单击确定完成。
- 在出现第二个输入框时输入以逗号分隔的单词(例如 Abc、Xyz),然后单击确定。
笔记, 请记住,它区分大小写,因此请按照单元格中所写的完全一致地写入单词。