查找缺失一边的单引号

相见是缘8 · 发表于 2019-9-21 10:58

本帖最后由相见是缘8 于 2019-9-21 14:10 编辑

查找缺失一边的单引号

我学中医的弟弟，昨天发来一个文档让我帮忙，就是文档内的前后单引号不成对，数量相差很多（前单引号2千多个，后单引号5千多个），如用人工查误配对，一是工作量太大，二是不准确，容易遗漏。

由于本人水平未到，特发帖求老师们写个VBA解决。我的想法是：从文档开始处向下查找，查到一前一后合格的一对引号（不考虑套层的引号），程序就跳过，查到不成对不合格的引号（如：一个前引号多个后引号的；多个前引号一个后引号的；多个前引号多个后引号的……），程序就让光标停在此处，并加上一红色★，程序停止。

加上一红色★的目的，是代替人工查误，好更正。

如老师们有更好的方法能达到目的，优先！

模拟：

一个前引号多个后引号的：

……‘××××××××××××’，’××××××××××××’。’××××××××××××……

多个前引号一个后引号的：

……‘××××××××××××‘，‘××××××××××××‘。’××××××××××××……

多个前引号多个后引号的：

……‘××××××××××××‘，‘××××××××××××，……’××××××××××××’。’××××××××××××’……

……

相见是缘8 · 发表于 2019-9-24 07:59

几天都不见有老师们回复，是老师们太忙了？还是我这个想法不可能实现？

413191246se · 发表于 2019-9-24 13:43

本帖最后由 413191246se 于 2019-9-24 14:37 编辑

相见你好！我不忙，但：
1、我觉得这么深奥的医学知识对于你弟弟阅读、校对来说是否合适！？
2、个人遇见：单引号全部转换为双引号，效果比较好！但问题并不简单，还有例外。
* 下面是体验代码：（请注意：慢电脑上运行时间超过 5 分钟，请耐心等等）

Sub test双引号()
'左单引号转左双引号
With ActiveDocument.Content.Find
.ClearFormatting
.Text = Chr(-24146)
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
.Font.Color = wdColorRed
.Text = Chr(-24144)
.Start = .End
End With
Loop
End With
'右单引号转右双引号
With ActiveDocument.Content.Find
.ClearFormatting
.Text = Chr(39)
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
.Font.Color = wdColorPink
.Text = Chr(-24143)
.Start = .End
End With
Loop
End With
'''
'回车符+右双引号==>左双引号
With ActiveDocument.Content.Find
.ClearFormatting
.Text = vbCr & Chr(-24143)
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
.MoveStart
.Font.Color = wdColorBlue
.Text = Chr(-24144)
.Start = .End
End With
Loop
End With
Selection.HomeKey 6
MsgBox "处理完毕！！！！！！！！！！！！", 0 + 48
End Sub

复制代码

相见是缘8 · 发表于 2019-9-25 08:18

413191246se 发表于 2019-9-24 13:43
相见你好！我不忙，但：
1、我觉得这么深奥的医学知识对于你弟弟阅读、校对来说是否合适！？
2、个人遇 ...

老师好！
感谢援手相助！
阅读这个文档对于我这个读了大学的人都吃力，一个是看不懂里面的专业词句，二一个可能是文档没整理好也有因素。校对就更谈不上，因里面丢失了很多各种的标点符号，特别是当设及到中医古文及专业词句的时候，断不了句，就很难整理下去。没办法只能尽我所能，以后再让他问他的师父及师哥们！

老师、我测试了你给的代码，看效果你是把单引号全部转换为了双引号，前后双引号各做了一个颜色区分，是吧？这个让查找不成对的双引号时更醒目了，进了一步，但还未达我要的目的，老师你有更好的吗？！

另外、单引号全部转换为双引号，效果是比较好，但如碰到文档里面原来有双引号的，在它里面的单引号就会变为套层的双引号，在以后查找时会不会变得更因难？

413191246se · 发表于 2019-9-25 09:39

* 我估计嵌套的单引号不太多。
* 双引号符合文章阅读习惯。
* 至于有方向颠倒的不算什么大事，大多数情况下阅读良好，暂时没有更好方案。

相见是缘8 · 发表于 2019-9-25 16:43

413191246se 发表于 2019-9-25 09:39
* 我估计嵌套的单引号不太多。
* 双引号符合文章阅读习惯。
* 至于有方向颠倒的不算什么大事，大多数情况 ...

好的，感谢老师！
看还能不能碰到别的老师，有更好的方法！

sylun · 发表于 2019-9-25 20:52

本帖最后由 sylun 于 2019-9-25 23:26 编辑

可试试如下代码，只做了简单测试。用突出显示标记，可处理待定区域

Sub test()
'运行代码前请先将文档中的半角后单引号替换为全角后单引号，或将代码行中的ChrW(8217)改为chr(39)
Dim myRange As Range
Dim aRange As Range
Dim myend As Long
Dim mylen As Long
Application.ScreenUpdating = False
' ActiveDocument.Range.Find.Execute findtext:=Chr(39), replacewith:=ChrW(8217), Replace:=wdReplaceAll
Set myRange = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
With myRange
myend = .End
mylen = InStr(.Text, ChrW(8217))
If InStr(Left(.Text, mylen), ChrW(8216)) = 0 And mylen > 0 Then
.End = .Start + mylen
.HighlightColorIndex = wdPink
.Select
MsgBox "后单引号开头！", vbCritical
Exit Sub
End If
End With
Do
With myRange.Find
.MatchWildcards = True
.Text = ChrW(8216) & "[!" & ChrW(8217) & "]@" & ChrW(8217) '查找一个完整的引号对
If .Execute = True Then '找到匹配时
Set aRange = .Parent.Duplicate
aRange.Select
If InStr(2, aRange.Text, ChrW(8216)) > 0 Then '匹配中还有前单引号时
aRange.HighlightColorIndex = wdYellow
aRange.Select
MsgBox "连续" & UBound(Split(aRange.Text, ChrW(8216))) & "个前单引号！"
Exit Do
Else
aRange.MoveEndUntil ChrW(8216), ActiveDocument.Range(.Parent.End, myend).Characters.Count
aRange.Select
'匹配后接着还是后单引号时
If InStr(ActiveDocument.Range(.Parent.End, aRange.End).Text, ChrW(8217)) > 0 Then
aRange.HighlightColorIndex = wdBrightGreen
MsgBox "连续" & UBound(Split(aRange.Text, ChrW(8217))) & "个后单引号！"
Exit Do
End If
.Parent.SetRange aRange.End, myend
End If
Else '找不到匹配时
With myRange
.End = myend
If InStr(.Text, ChrW(8216)) > 0 And InStr(.Text, ChrW(8217)) > 0 Then
.HighlightColorIndex = wdPink
MsgBox "前后单引号错位！"
ElseIf InStr(.Text, ChrW(8216)) > 0 Then
.HighlightColorIndex = wdYellow
MsgBox "只有前单引号！"
ElseIf InStr(.Text, ChrW(8217)) > 0 Then
.HighlightColorIndex = wdBrightGreen
MsgBox "只有后单引号！"
<blockquote> Else

复制代码

相见是缘8 · 发表于 2019-9-26 07:16

sylun 发表于 2019-9-25 20:52
可试试如下代码，只做了简单测试。用突出显示标记，可处理待定区域

老师好！
感谢老师提供代码！
我把代码复制粘贴进代码窗口，最后一行的这句 <blockquote> Else 代码为红色，也运行不了，提示 “编辑错误、语法错误”，不知怎么会事，还请你详告，谢谢！

sylun · 发表于 2019-9-26 20:09

相见是缘8 发表于 2019-9-26 07:16
老师好！
感谢老师提供代码！
我把代码复制粘贴进代码窗口，最后一行的这句 Else ...

我每次编辑修改帖子都遇到类似这样的问题，不知什么原因，而且还需审核，无法即时知道保存后的修改结果。
代码为：

Sub test()
'运行代码前请先将文档中的半角后单引号替换为全角后单引号，或将代码行中的ChrW(8217)改为chr(39)
Dim myRange As Range
Dim aRange As Range
Dim myend As Long
Dim mylen As Long
Application.ScreenUpdating = False
' ActiveDocument.Range.Find.Execute findtext:=Chr(39), replacewith:=ChrW(8217), Replace:=wdReplaceAll
Set myRange = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
With myRange
myend = .End
mylen = InStr(.Text, ChrW(8217))
If InStr(Left(.Text, mylen), ChrW(8216)) = 0 And mylen > 0 Then
.End = .Start + mylen
.HighlightColorIndex = wdPink
.Select
MsgBox "后单引号开头！", vbCritical
Exit Sub
End If
End With
Do
With myRange.Find
.MatchWildcards = True
.Text = ChrW(8216) & "[!" & ChrW(8217) & "]@" & ChrW(8217) '查找一个完整的单引号对
If .Execute = True Then '找到匹配时
Set aRange = .Parent.Duplicate
aRange.Select
If InStr(2, aRange.Text, ChrW(8216)) > 0 Then '匹配中还有前单引号时
aRange.HighlightColorIndex = wdYellow
aRange.Select
MsgBox "连续" & UBound(Split(aRange.Text, ChrW(8216))) & "个前单引号！"
Exit Do
Else
aRange.MoveEndUntil ChrW(8216), ActiveDocument.Range(.Parent.End, myend).Characters.Count
aRange.Select
'匹配后接着还是后单引号时
If InStr(ActiveDocument.Range(.Parent.End, aRange.End).Text, ChrW(8217)) > 0 Then
aRange.HighlightColorIndex = wdBrightGreen
MsgBox "连续" & UBound(Split(aRange.Text, ChrW(8217))) & "个后单引号！"
Exit Do
End If
.Parent.SetRange aRange.End, myend
End If
Else '找不到匹配时
With myRange
.End = myend
If InStr(.Text, ChrW(8216)) > 0 And InStr(.Text, ChrW(8217)) > 0 Then
.HighlightColorIndex = wdPink
MsgBox "前后单引号错位！"
ElseIf InStr(.Text, ChrW(8216)) > 0 Then
.HighlightColorIndex = wdYellow
MsgBox "只有前单引号！"
ElseIf InStr(.Text, ChrW(8217)) > 0 Then
.HighlightColorIndex = wdBrightGreen
MsgBox "只有后单引号！"
Else
MsgBox "没有发现异常！"
End If
Exit Do
End With
End If
End With
Loop
Application.ScreenUpdating = True
End Sub

复制代码

相见是缘8 · 发表于 2019-9-27 07:56

sylun 发表于 2019-9-26 20:09
我每次编辑修改帖子都遇到类似这样的问题，不知什么原因，而且还需审核，无法即时知道保存后的修改结果。 ...

老师、辛苦了！
我按照你的提示‘运行代码前，先将文档中的半角后单引号全部替换为了全角后单引号’，再运行你的代码，结果好象只是查找到一处一个前引号后面5个单引号的，其它不成对不合格的引号并没有查找出来，能不能劳你把代码再优化一下，把凡是不成对不合格的引号都查找出来？！

我的目的是：从文档开始处向下查找，查到一前一后合格的一对引号（不考虑套层的引号），程序就跳过，查到不成对不合格的引号（如：一个前引号多个后引号的；多个前引号一个后引号的；多个前引号多个后引号的……），程序就让光标停在此处，并加上一红色★，程序停止。
加上一红色★的目的，是代替人工查误，好更正。

		自动登录	找回密码
密码			免费注册

[求助] 查找缺失一边的单引号