Ошибка в Excel VBA изменить шрифт текста в ячейке

Я сделал функцию для поиска и замены текста в ячейке на листе Excel, после замены которого он должен выделять текст, выделяя его жирным шрифтом и определенным цветом. Сначала казалось, что это работает, но теперь я обнаружил, что в определенных случаях происходит какое-то странное поведение. Кажется, что когда я начинаю менять цвет текста в позициях, отличных от первой позиции, в конце может быть добавлен случайный текст. Кроме того, кажется, что Excel после этого становится нестабильным.

Я обнаружил этот вопрос в теме, где у кого-то есть очень похожая проблема, только тогда с изменением фактического шрифта. Из этого я узнал, что ошибки можно избежать, всегда «касаясь» первого символа. В настоящее время я меняю цвет первого символа на его собственный цвет в качестве обходного пути, но я не уверен, что эта проблема не появится позже.

Вот изображения ячеек в excel и поведение, когда что-то идет не так:

Вот почему мне было любопытно, видел ли кто-нибудь эту проблему и есть ли для нее чистое «решение».

Public Sub Find_and_replace_in_string(CellToEvaluate As Range, ValueToBeFoundAndReplaced As String, Newvalue As String, Mark_updated As Integer)
Dim startchar As Integer
Dim len_input As Integer
Dim len_newvalue As Integer
Dim endchar As Integer
Dim string_input As String
Dim oRange As Excel.Range
Set oRange = CellToEvaluate
startchar = 1 ' init value
len_newvalue = Len(Newvalue)
Application.ScreenUpdating = False
If oRange.Cells.Count = 1 Then
    While startchar <> 0
        string_input = oRange.Cells.Value
        startchar = InStr(startchar, string_input, ValueToBeFoundAndReplaced)
        'check if the first character after the match is a comma or en of string
        If startchar <> 0 Then
            endchar = startchar + Len(ValueToBeFoundAndReplaced)
            If Mid(string_input, endchar, 1) = "" Or Mid(string_input, endchar, 1) = "," Then
                len_input = Len(ValueToBeFoundAndReplaced)
                'use replace function in a very specific region to replace the correct part
                With oRange.Characters(Start:=startchar, Length:=len_input)
                    .Text = Newvalue
                End With
                'oRange.Cells.Characters(Start:=startchar, Length:=len_input).Text = Newvalue

                ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                ''quick Fix for Issue with randomly changing fonts, if first character is not changed
                'With oRange.Characters(Start:=1, Length:=1).Font
                '    .ColorIndex = .ColorIndex
                'End With
                '"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""


                If Mark_updated <> 0 Then
                    With oRange.Characters(Start:=startchar, Length:=len_newvalue).Font
                        .Bold = True
                        .ColorIndex = Mark_updated '.ColorIndex + 1
                    End With
                    'oRange.Cells.Characters(Start:=startchar, Length:=len_newvalue).Font.colorindex = Mark_updated
                End If
            End If
            startchar = startchar + len_newvalue
        Else
            startchar = 0
        End If
    Wend
End If
Application.ScreenUpdating = True
End Sub

Public Sub test_find_and_replace()
     Dim example_sheet As Excel.Worksheet
     Set example_sheet = Sheets("Sheet1")
     Find_and_replace_in_string example_sheet.Cells(3, 1), "one", "111", 3
End Sub

с уважением, Град