检测单元格加粗文本并添加'Total'：VBA代码故障排查

你的VBA代码存在多个语法和逻辑问题，导致无法正常运行，具体问题和修复方案如下：

存在的问题 #

• 未声明/赋值工作表对象ws：直接使用ws.Range会触发“变量未定义”错误，必须指定具体工作表（比如Sheet1或ActiveSheet）。
• 未定义words数组：代码中使用了words数组但未初始化、赋值，属于无意义的变量引用，会直接报错。
• 代码结构不完整：缺少End If（内层和外层条件判断均未闭合）、Next i、Next cell，属于语法错误，编译器无法通过。
• 逻辑错误：即使找到加粗文本，修改words(i)也不会同步到单元格内容，需要将修改后的文本主动写回单元格。

修正后的代码 #

场景1：给单元格内所有加粗文本片段添加“ Total”后缀 #

如果你的需求是精准定位单元格内的加粗文本片段并添加后缀，可用以下代码：

Sub AddTotalToBoldText()
    Dim rng As Range
    Dim cell As Range
    Dim startPos As Integer
    Dim endPos As Integer
    Dim originalText As String
    Dim newText As String
    
    ' 指定目标工作表，可根据实际修改为你的工作表名称
    Set rng = Sheet1.Range("C1:C2000")
    
    For Each cell In rng
        If Not IsEmpty(cell.Value) Then
            originalText = cell.Value
            newText = originalText
            startPos = 1
            
            ' 遍历单元格字符，定位连续加粗的文本片段
            Do While startPos <= Len(originalText)
                ' 找到第一个加粗字符的位置
                Do While startPos <= Len(originalText) And Not cell.Characters(startPos, 1).Font.Bold
                    startPos = startPos + 1
                Loop
                If startPos > Len(originalText) Then Exit Do
                
                ' 找到当前加粗片段的结束位置
                endPos = startPos
                Do While endPos <= Len(originalText) And cell.Characters(endPos, 1).Font.Bold
                    endPos = endPos + 1
                Loop
                endPos = endPos - 1
                
                ' 给加粗片段添加后缀
                newText = Left(newText, endPos) & " Total" & Mid(newText, endPos + 1)
                ' 调整起始位置，跳过已处理的内容
                startPos = endPos + 1 + Len(" Total")
            Loop
            
            ' 将修改后的文本写回单元格
            If newText <> originalText Then
                cell.Value = newText
            End If
        End If
    Next cell
End Sub

场景2：整个单元格为加粗状态时添加“ Total”后缀 #

如果你的需求是只要单元格整体加粗，就给文本添加后缀，可用更简化的版本：

Sub AddTotalToBoldCells()
    Dim rng As Range
    Dim cell As Range
    
    Set rng = Sheet1.Range("C1:C2000")
    
    For Each cell In rng
        If Not IsEmpty(cell.Value) And cell.Font.Bold Then
            cell.Value = cell.Value & " Total"
        End If
    Next cell
End Sub

内容的提问来源于stack exchange，提问作者kiki