查找/替换VBA代码未正确执行

Question

出于某种奇怪的原因，我的代码并非在所有情况下都有效。它不会捕获句点后只有 1 个空格的每个实例。我想知道是否有人知道为什么会这样。我遍历了每一行，我不知道为什么它不起作用。这是非常基本的代码。

此代码背后的目标：

具有

1. 1 个空格的句点转到具有 2 个空格的句点
2. 2个空格的句点保持不变
3. 文档中任何不跟句点的双倍空格都将更改为 1 个空格。
4. 先生，夫人，小姐，女士在他们之后只有1个空格。

Sub Space_corrections()
' two spaces go to one space entire doc
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "  "
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' One space after periods goes to two spaces
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ". "
.Replacement.Text = ".  "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' Three spaces after periods goes to two spaces
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".   "
.Replacement.Text = ".  "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' Two spaces after Mr. goes to one space
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Mr.  "
.Replacement.Text = "Mr. "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' Two spaces after Mrs. goes to one space
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Mrs.  "
.Replacement.Text = "Mrs. "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' Two spaces after Ms. goes to one space
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Ms.  "
.Replacement.Text = "Ms. "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' Two spaces after Miss. goes to one space
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Miss.  "
.Replacement.Text = "Miss. "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

End Sub```

UPDATE/EDIT: 
I changed over to this code, but it does to change all of the instances. I am not sure what the cause is. 
There is no special font on them or anything. They are sentences that are contained by a list format, but every other instance that was changed was also contained in a list format. 
These are the instances that went unchanged:
**"shipped. According"
"materials. The"**
updated code: 
Sub Space_corrections_123()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "(.)( {1,})"
.Replacement.Text = "1  "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

End Sub

Answer 1

您可以使用通配符搜索简化先生/夫人/小姐/女士/博士/教授等的查找和替换

.findtext="([rs])(.  )"  
.replacementText="1. "

这将找到任何以 r 或 s 结尾的单词，后跟一个点和两个空格，并替换为找到的字符加点和一个空格。

您还可以执行通配符搜索以合并 的替换 . by to 。 两个空格使用

.findtext="(.)( {1,})"  
.replacementText="1  "

Answer 2

尝试：

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = False
.Wrap = wdFindContinue
.MatchWildcards = True
.Text = "([ ^s]){2,}"
.Replacement.Text = "1"
.Execute Replace:=wdReplaceAll
.Text = "(. )"
.Replacement.Text = "1 "
.Execute Replace:=wdReplaceAll
.Text = "([DM][irs]{1,3}.)[ ]{2,}"
.Replacement.Text = "1 "
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub

请注意"[DM]"中的"D"。这使您可以找到Dr.和Drs.(以防不止一个(。如果没有必要，您可以删除"D"。