如何定义独立Word.Range遍历原Range且避免修改影响原对象？

这个问题我之前也踩过坑——你现在的代码里，Set workRange = parseRange这种赋值方式是传递对象引用，也就是说workRange和parseRange指向的是同一个Range对象。就像给同一个文件夹建了两个快捷方式，修改其中一个的属性（比如调整范围、修改文本），另一个也会立刻跟着变化，这就是为什么你清空workRange的文本后，parseRange.Characters.Count直接变成2，导致后续循环崩溃。

核心解决方案：使用Range.Duplicate创建独立副本 #

Word的Range对象提供了Duplicate属性，它会生成一个和原Range内容完全一致，但完全独立的新Range对象。修改这个副本的任何属性，都不会影响原Range的属性值（比如Start、End、Characters.Count）。

修改后的代码示例 #

把你原来的三个Set语句替换成使用Duplicate的版本，同时补充了循环索引的调整逻辑（避免删除字符后索引混乱）：

Private Sub parse(parseRange As Word.Range)
    'technical range for starting double asterics
    Dim workRange As Word.Range
    'range for enclosing doulbe asterics
    Dim workRange2 As Word.Range
    'another range for a bold text
    Dim workRange3 As Word.Range
    'flag variable
    Dim isSelect As Boolean
    'number of iterated character in parseRange
    Dim char As Long
    '使用Duplicate创建独立副本，避免修改原parseRange
    Set workRange = parseRange.Duplicate
    Set workRange2 = parseRange.Duplicate
    Set workRange3 = parseRange.Duplicate
    
    '先保存原Range的字符总数，避免中途文档内容变化导致循环出错
    Dim originalCharCount As Long
    originalCharCount = parseRange.Characters.Count
    
    char = 2
    isSelect = False
    Do While char <= originalCharCount
        If parseRange.Characters(char) = "*" And parseRange.Characters(char - 1) = "*" Then
            Select Case isSelect
                Case False
                    isSelect = True
                    '基于原Range的位置设置workRange的范围
                    workRange.Start = parseRange.Start + char - 2
                    workRange.End = parseRange.Start + char
                    workRange.Text = ""
                    '删除字符后，后续的字符位置会前移，所以char需要减2（因为删掉了两个*）
                    originalCharCount = originalCharCount - 2
                    char = char - 2
                Case True
                    isSelect = False
                    workRange2.Start = parseRange.Start + char - 2
                    workRange2.End = parseRange.Start + char
                    workRange2.Text = ""
                    '设置粗体范围
                    workRange3.SetRange Start:=workRange.End, End:=workRange2.Start
                    workRange3.Bold = True
                    '删除字符后调整计数和索引
                    originalCharCount = originalCharCount - 2
                    char = char - 2
            End Select
        End If
        char = char + 1
    Loop
End Sub

额外优化思路：基于字符串处理更稳定 #

如果要处理大量文本，建议先把Range的文本提取到字符串中，在字符串里找出所有**的位置，再回到Range中设置格式并删除标记。这种方式可以彻底避免文档内容动态变化导致的索引混乱，示例如下：

Private Sub parse(parseRange As Word.Range)
    Dim originalText As String
    originalText = parseRange.Text
    Dim startPos As Long, endPos As Long
    Dim currentPos As Long
    
    currentPos = 1
    Do
        startPos = InStr(currentPos, originalText, "**")
        If startPos = 0 Then Exit Do
        
        endPos = InStr(startPos + 2, originalText, "**")
        If endPos = 0 Then Exit Do
        
        '设置粗体范围
        Dim boldRange As Word.Range
        Set boldRange = parseRange.Duplicate
        boldRange.Start = parseRange.Start + startPos - 1
        boldRange.End = parseRange.Start + endPos - 1
        boldRange.Bold = True
        
        '删除前后的**
        Dim removeRange As Word.Range
        '删除开头的**
        Set removeRange = parseRange.Duplicate
        removeRange.Start = parseRange.Start + startPos - 1
        removeRange.End = removeRange.Start + 2
        removeRange.Text = ""
        '删除结尾的**（注意因为前面删了两个字符，endPos要减2）
        Set removeRange = parseRange.Duplicate
        removeRange.Start = parseRange.Start + endPos - 3
        removeRange.End = removeRange.Start + 2
        removeRange.Text = ""
        
        '更新原文本和当前位置，继续处理后续内容
        originalText = parseRange.Text
        currentPos = endPos - 4 '因为删了4个字符（前后各两个**）
    Loop
End Sub

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