如何将HTML <b>标签间的文本设为粗体？VBA代码问题排查

原始文本 #

(27)Some normal text<b>, and some bold text</b>, in a paragraph<b>.</b>.

问题场景 #

现有一段包含HTML <b>/</b> 转义标签的文本，尝试用VBA设置粗体时，原代码虽能部分设置粗体，但无法彻底移除标签，还会误删部分文本：

Sub BoldTags()
Dim X As Long, BoldOn As Boolean
BoldOn = False 'Default from start of cell is not to bold
For X = 1 To Len(ActiveCell.Text)
    If UCase(Mid(ActiveCell.Text, X, 3)) = "<b>" Then
        BoldOn = True
        ActiveCell.Characters(X, 3).Delete
    End If
    If UCase(Mid(ActiveCell.Text, X, 4)) = "</b>" Then
        BoldOn = False
        ActiveCell.Characters(X, 4).Delete
    End If
    ActiveCell.Characters(X, 1).Font.Bold = BoldOn
Next
End Sub

原代码核心问题：直接在单元格中删除字符会导致后续字符索引位置混乱，循环的X值无法匹配变化后的文本长度，最终标签删不干净，还会错删正常文本。

修正方案 #

先将单元格文本提取到变量中处理，识别标签位置并记录粗体区间，再清除原始文本并重新写入纯文本，最后根据记录的区间设置粗体格式：

Sub ProcessBoldTags()
    Dim originalText As String, cleanText As String
    Dim pos As Long, tagStart As Long, tagEnd As Long
    Dim boldRanges As Collection
    Dim currentBoldStart As Long, isBold As Boolean
    
    ' 初始化变量
    Set boldRanges = New Collection
    originalText = ActiveCell.Text
    cleanText = ""
    pos = 1
    isBold = False
    
    ' 遍历原始文本，提取纯文本并记录粗体区间
    Do While pos <= Len(originalText)
        ' 查找<b>标签
        tagStart = InStr(pos, originalText, "&lt;b&gt;")
        ' 查找</b>标签
        tagEnd = InStr(pos, originalText, "&lt;/b&gt;")
        
        ' 优先处理更早出现的标签
        If (tagStart > 0 And tagStart < tagEnd) Or tagEnd = 0 Then
            If tagStart > pos Then
                ' 添加标签前的普通文本
                cleanText = cleanText & Mid(originalText, pos, tagStart - pos)
                ' 如果当前是粗体状态，记录区间
                If isBold Then
                    boldRanges.Add Array(Len(cleanText) - (tagStart - pos) + 1, Len(cleanText))
                End If
            End If
            ' 切换粗体状态为开
            isBold = True
            pos = tagStart + 6 ' 跳过&lt;b&gt;的长度（6个字符）
        ElseIf tagEnd > 0 Then
            If tagEnd > pos Then
                ' 添加标签前的粗体文本
                cleanText = cleanText & Mid(originalText, pos, tagEnd - pos)
                ' 记录粗体区间
                boldRanges.Add Array(Len(cleanText) - (tagEnd - pos) + 1, Len(cleanText))
            End If
            ' 切换粗体状态为关
            isBold = False
            pos = tagEnd + 7 ' 跳过&lt;/b&gt;的长度（7个字符）
        Else
            ' 处理剩余文本
            cleanText = cleanText & Mid(originalText, pos)
            ' 如果当前是粗体状态，记录区间
            If isBold Then
                boldRanges.Add Array(Len(cleanText) - (Len(originalText) - pos) + 1, Len(cleanText))
            End If
            Exit Do
        End If
    Loop
    
    ' 清空单元格并写入纯文本
    ActiveCell.Value = cleanText
    
    ' 应用粗体格式
    Dim rng As Variant
    For Each rng In boldRanges
        ActiveCell.Characters(rng(0), rng(1) - rng(0) + 1).Font.Bold = True
    Next rng
    
    ' 释放对象
    Set boldRanges = Nothing
End Sub

代码说明 #

1. 文本预处理：将单元格文本提取到变量中，避免直接修改单元格内容导致的索引混乱。
2. 区间记录：遍历文本时识别<b>/</b>标签，记录需要设置粗体的文本区间，同时生成去除标签的纯文本。
3. 格式应用：先将纯文本写入单元格，再根据记录的区间批量设置粗体格式，确保格式准确。

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