How to highlight substring using LIKE operator in

问题:

I have strings that look like this:

DTTGGRKDVVNHCGKKYKDK
RKDVVNHCGKKYKDKSKRAR

What I want to do is to highlight the region with bold and red font. Resulting this:

I tried the following code using LIKE operator in Excel VBA but it breaks at this line Set MC = .Execute(C.Text)

Option Explicit
Sub boldSubString()
    Dim R As Range, C As Range
    Dim MC As Object    

    Set R = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))

    For Each C In R
        C.Font.Bold = False
        If C.Text Like "KK*K" Or C.Text Like "KR*R"  Then
            Set MC = .Execute(C.Text)
            C.Characters(MC(0).firstindex + 1, MC(0).Length).Font.Bold = True
        End If
    Next C    

End Sub

What's the right way to do it? I'm using Mac Excel Version 15.31

回答1:

Without Regular Expressions, you can try the following. I've not tested it extensively but it does seem to work even with multiple matching substrings within the same string.

Examine VBA HELP for the functions that are being used, so you understand how this works, and also how to construct proper patterns to be used with the Like operator, in case you need to expand the list of possible patterns.

Option Explicit
Sub boldSS()
    Dim WS As Worksheet
    Dim R As Range, C As Range
    Dim sPatterns(1) As String
    Dim I As Long, J As Long

sPatterns(0) = "KR?R"
sPatterns(1) = "KK?K"

Set WS = Worksheets("sheet1")
With WS
    Set R = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

For Each C In R

        'Reset to default
        With C.Font
            .Bold = False
            .Color = vbBlack
        End With

    For I = 0 To UBound(sPatterns)
        If C Like "*" & sPatterns(I) & "*" Then
            For J = 1 To Len(C) - Len(sPatterns(I)) + 1
                If Mid(C, J, Len(sPatterns(I))) Like sPatterns(I) Then
                    With C.Characters(J, Len(sPatterns(I))).Font
                        .Bold = True
                        .Color = vbRed
                    End With
                    If J < Len(C) - 3 Then
                        J = J + 3
                    Else
                        Exit For
                    End If
                End If
            Next J
        End If
    Next I
Next C
End Sub

Using your regex pattern equivalent instead for the Like operator, you can rewrite the above as below. Note that your Regex pattern will also match KKAR, and KRAK (as does the macro below, but not the one above).

Option Explicit
Sub boldSS()
    Dim WS As Worksheet
    Dim R As Range, C As Range
    Dim sPattern As String
    Dim I As Long

sPattern = "K[KR]?[KR]"

Set WS = Worksheets("sheet1")
With WS
    Set R = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

For Each C In R
        With C.Font
            .Bold = False
            .Color = vbBlack
        End With
        If C Like "*" & sPattern & "*" Then
            For I = 1 To Len(C) - 4 + 1
                If Mid(C, I, 4) Like sPattern Then
                    With C.Characters(I, 4).Font
                        .Bold = True
                        .Color = vbRed
                    End With
                    If I < Len(C) - 3 Then
                        I = I + 3
                    Else
                        Exit For
                    End If
                End If
            Next I
        End If
Next C
End Sub

回答2:

SubString problems could be complicated, once one drills a bit in them. E.g., in the OP example, the substring KKYKDKSK also is a correct substring of KK*K, thus, it probably could be color coded as well.

In general, with some limitations the task, like searching for non-overlapping substrings and considering that the substring is present once per string, this is possible:

With some hardcoding of the variables and checking only for KK*K, this is how the main method looks like:

Option Explicit    
Sub TestMe()

    Dim myRange As Range: Set myRange = Worksheets(1).Range("A1:A2")

    Dim myCell As Range
    For Each myCell In myRange
        myCell.Font.Bold = False
        Dim subString As String
        subString = findTheSubString(myCell.Value2, "KK*K")
        Debug.Print myCell.text, subString
        ChangeTheFont subString, myCell, vbBlue
    Next myCell

End Sub

The function findTheSubString() takes the 2 strings and returns the substring, which is to be color-coded later:

Public Function findTheSubString(wholeString As String, subString As String) As String

    Dim regEx           As Object
    Dim inputMatches    As Object
    Dim regExString     As String

    Set regEx = CreateObject("VBScript.RegExp")

    With regEx
        .Pattern = Split(subString, "*")(0) & "[\s\S]*" & Split(subString, "*")(1)
        .IgnoreCase = True
        .Global = True

        Set inputMatches = .Execute(wholeString)
        If regEx.test(wholeString) Then
            findTheSubString = inputMatches(0)
        Else
            findTheSubString = "Not Found!"
        End If

    End With

End Function

The last part is to change the font of a specific substring in Excel range, thus the arguments are a string and a range:

Sub ChangeTheFont(lookFor As String, currentRange As Range, myColor As Long)

    Dim startPosition As Long: startPosition = InStr(1, currentRange.Value2, lookFor)
    Dim endPosition As Long: endPosition = startPosition + Len(currentRange.Value2)

    With currentRange.Characters(startPosition, Len(lookFor)).Font
        .Color = myColor
        .Bold = True
    End With
End Sub