需要建议或帮助来修改可以在VBA通配符搜索后搜索子字符串和格式的宏

Question

我有一个问题要问在座的各位才华横溢的VBA专家。我发现了这个超级酷的宏，它为通过输入框提供的文本着色。然而，我尝试了一点修改，我正在尝试使用通配符"*"例如，如果我提供VBA*，那么在输入中，从"VBA"到所选范围中文本末尾的字符串应该被格式化。一个瞪大眼睛的子字符串格式化vba代码。没有找到，所以我修改了这个代码，希望你们中的一个人能在一瞬间添加一些魔法。

这是我在搜索中找到的代码：

Sub X_FormatSubStrings()
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:", "Enter the string", "")
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
xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.Bold = 3
xStrTmp = xStrTmp & xHStr
Next
End If
Next
Application.ScreenUpdating = True
MsgBox "Done"
End Sub

Answer 1

虽然问题不清楚，代码也有多个问题，但我认为它适用于Excel，并且只打算使用*作为通配符租船人。试图对代码进行修改以达到预期用途。

Sub X_FormatSubStrings()
Dim xHStr As String, CellStr As String
Dim xStrTmp As String, xHStrLen As Long
Dim xCount As Long, i As Long, StPos As Long, EndPos As Long, Pos As Long
Dim xCell As Range
Dim xArr
xHStr = InputBox("What is the string to highlight:", "Enter the string", "*asd*rt*ss*")
If TypeName(xHStr) <> "String" Then Exit Sub
If Len(xHStr) = 0 Then Exit Sub
xArr = Split(xHStr, "*")
For Each xCell In Selection
CellStr = xCell.Value
StPos = 0
EndPos = 0

For i = LBound(xArr) To UBound(xArr)
Pos = InStr(1, CellStr, xArr(i))
If Pos <= 0 Then Exit For
If i = LBound(xArr) Then StPos = Pos
If i = UBound(xArr) Then EndPos = Pos + Len(xArr(i)) - 1
If i = UBound(xArr) And xArr(i) = "" Then EndPos = Len(CellStr)
Next i
If StPos > 0 And EndPos >= StPos Then
xCell.Characters(StPos, EndPos - StPos + 1).Font.ColorIndex = 3
xCell.Characters(StPos, EndPos - StPos + 1).Font.Bold = True
End If
Next xCell
MsgBox "Done"
End Sub