Vba 从空白中删除下标/上标

我的目标是删除空格中的下标或上标格式

当我运行下面的代码时，只有上面的函数起作用，而下面的函数什么都做不了。如果我切换功能的位置，仍然只有顶部功能工作。功能几乎相同，我不知道从哪里开始修复这个问题。请有人给我指一下正确的方向好吗

Dim oRng As Word.Range
Set oRng = ActiveDocument.Range

'For subscripted spaces

Selection.HomeKey unit:=wdStory
With oRng.Find
 .ClearFormatting
 .Replacement.ClearFormatting
.Forward = True
.Text = "[A-z0-9] "
.Replacement.Text = ""
.MatchWholeWord = False
    While .Execute
        If oRng.Characters(2).Font.Subscript = True Then
        oRng.Characters(2).Font.Subscript = False
        End If
    oRng.Collapse direction:=wdCollapseEnd
    Wend
End With

'For superscripted spaces

 Selection.HomeKey unit:=wdStory
With oRng.Find
 .ClearFormatting
 .Replacement.ClearFormatting
.Forward = True
.Text = "[A-z0-9] "
.Replacement.Text = ""
.MatchWholeWord = False
    While .Execute
        If oRng.Characters(2).Font.Superscript = True Then
        oRng.Characters(2).Font.Superscript = False
        End If
    oRng.Collapse direction:=wdCollapseEnd
    Wend
End With

---

问题是，当您处理完放在第一位的序列时，Rng定义的范围已塌陷到最后找到的实例。无论如何，您不需要循环。尝试：

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = " "
    .Replacement.Text = "^&"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .Font.Superscript = True
    .Replacement.Font.Superscript = False
    .Execute Replace:=wdReplaceAll
    .Font.Subscript = True
    .Replacement.Font.Subscript = False
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

---

欢迎看起来您正在使用范围

oRng

，但是重置了选择…您的代码不完整，这使得我们无法准确地发现它是如何失败的。根据现场政策，应提供一份书面报告。具体来说，在这种情况下，与设置和处理

oRng

相关的一切都是相关的。对此，辛迪深表歉意。我对文本进行了编辑，以澄清oRng的定义。