Excel VBA中的错误更改单元格中的文本字体

我做了一个函数来查找和replaceexcel表格中的单元格中的文本，一旦replace它应该强调文本，使其粗体和特定的颜色。 起初它似乎工作，但现在我发现，在特定情况下发生了一些奇怪的行为。 看起来，当我开始改变文本颜色的位置，而不是第一个位置，然后随机文本可以附加在结尾。 接下来，似乎excel之后变得不稳定。

我在一个话题中发现了这个问题，在这个话题中，只有在改变实际字体的情况下，才会有人遇到类似的问题 从这里我发现，可以通过总是“触摸”第一个字符来避免这个错误。 目前我改变了第一个字符的颜色作为一个工作，但我不确定这个问题不会popup以后。

这里是excel中单元格的图像和出错的行为：

这就是为什么我很好奇，如果有人看到这个问题，是否有一个干净的“解决scheme”。

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 

亲切的问候，Grard