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

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

1 个答案: