excel VBA 改变单元格内特定字符串的颜色

Sub ChangeTextColor()
    Dim targetCell As Range
    Dim tempText As String
    Dim startPos As Integer
    Dim endPos As Integer
    Dim searchText As String
    Dim i As Integer
    Dim d As Integer
    
    
    '设置目标单元格
    'Set targetCell = ActiveSheet.Range("B1") '假设目标单元格为A1，可以根据需要修改
    'Set targetCell = Selection
    
     ' 检查当前是否有选中的单元格
    If Not Selection.Cells.Count = 0 Then
        ' 遍历选中的每个单元格，并修改其文本颜色
        For Each cell In Selection
            Set targetCell = cell
             '获取单元格中的文本
            tempText = targetCell.Value
            
            '在文本中从位置1开始查找所有以"进展："开始、以"。"结束的字符串
            startPos = InStr(1, tempText, "进展：")
            Do While startPos > 0
                endPos = InStr(startPos, tempText, "。")
                If endPos > 0 Then
                    targetCell.Characters(startPos, endPos - startPos + 1).Font.Color = RGB(0, 112, 192) '将字符串更改为蓝色
                    startPos = InStr(endPos + 1, tempText, "进展：") '继续查找下一个匹配项
                Else
                    startPos = InStr(startPos + 3, tempText, "进展：") '如果没有找到结束标志，则继续查找下一个匹配项
                End If
            Loop
            
            '在文本中从位置1开始查找所有以"delay原因："开始、以"。"结束的字符串
            startPos = InStr(1, tempText, "delay原因：")
            Do While startPos > 0
                endPos = InStr(startPos, tempText, "。")
                If endPos > 0 Then
                    targetCell.Characters(startPos, endPos - startPos + 1).Font.Color = RGB(255, 0, 0) '将字符串更改为红色
                    startPos = InStr(endPos + 1, tempText, "delay原因：") '继续查找下一个匹配项
                Else
                    startPos = InStr(startPos + 3, tempText, "delay原因：") '如果没有找到结束标志，则继续查找下一个匹配项
                End If
            Loop
            
            '在文本中从位置1开始查找所有以"任务类型："开始、以"。"结束的字符串
            startPos = InStr(1, tempText, "任务类型：")
            Do While startPos > 0
                endPos = InStr(startPos, tempText, "。")
                If endPos > 0 Then
                    targetCell.Characters(startPos, endPos - startPos + 1).Font.Color = RGB(0, 112, 192) '将字符串更改为蓝色
                    startPos = InStr(endPos + 1, tempText, "任务类型：") '继续查找下一个匹配项
                Else
                    startPos = InStr(startPos + 3, tempText, "任务类型：") '如果没有找到结束标志，则继续查找下一个匹配项
                End If
            Loop
            
            '在文本中从位置1开始查找所有以"风险及应对："开始、以"。"结束的字符串
            startPos = InStr(1, tempText, "风险及应对：")
            Do While startPos > 0
                endPos = InStr(startPos, tempText, "。")
                If endPos > 0 Then
                    d = endPos - startPos
                    If d = 7 Then
                        targetCell.Characters(startPos, endPos - startPos + 1).Font.Color = RGB(0, 112, 192) '将字符串更改为红色
                    Else
                        targetCell.Characters(startPos, endPos - startPos + 1).Font.Color = RGB(255, 0, 0) '将字符串更改为蓝色
                    End If
                    startPos = InStr(endPos + 1, tempText, "风险及应对：") '继续查找下一个匹配项
                Else
                    startPos = InStr(startPos + 3, tempText, "风险及应对：") '如果没有找到结束标志，则继续查找下一个匹配项
                End If
            Loop
            
        Next cell
    Else
        MsgBox "请选中一个或多个单元格后再运行此操作！！"
    End If
    MsgBox "牛X啊！已经完成字体颜色格式格式化！"
   
End Sub