求一个查找文档内多余的标点符号并把它们改为蓝色的宏代码

413191246se · 发表于 2015-10-4 21:01

139：我觉得现在还无法准确区分汉字/汉字标点符号及一些英文标点符号，所以，我觉得批量处理文档也不太好，但如果你执意为之，也可以，建议每次批量处理不要太多，以免程序无响应（文件数<=300个为宜，在处理时不要动键盘和鼠标）。新增了省略号和破折号例外。——打包备份原文件后，先用几个示例文件试验之。

Sub 循环遍历文件夹_查找重复标点符号()
On Error Resume Next
Dim fd As FileDialog, i As Long, doc As Document, p As String, t As Long, s As Long, j As Paragraph
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then p = fd.SelectedItems(1) Else Exit Sub
Set fd = Nothing
If MsgBox("是否处理文件夹 " & p & " ?", vbYesNo + vbExclamation, "循环遍历文件夹_查找重复标点符号") = vbNo Then Exit Sub
With Application.FileSearch
.NewSearch
.LookIn = p
.SearchSubFolders = True
.FileName = "*.doc"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Set doc = Documents.Open(FileName:=.FoundFiles(i))
'查找重复标点符号
For Each j In doc.Paragraphs
j.Range.Select
If Len(j.Range) = 1 Then GoTo SkipEmpty
Selection.HomeKey Unit:=wdLine
Do
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
If Selection.Characters.Last Like vbCr Then GoTo SkipEmpty
If Selection.Characters.Last Like "[。；：，、！？;:,.?!…—]" Then
Do
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Loop Until Selection.Characters.Last Like "[!。；：，、！？;:,.?!…—]"
Selection.MoveEnd Unit:=wdCharacter, Count:=-1
If Len(Selection) > 1 And Not (Selection Like "……") And Not (Selection Like "——") Then
Selection.Font.Color = wdColorBlue '蓝色
' Selection.Range.HighlightColorIndex = wdBrightGreen '突出显示（鲜绿）
End If
End If
Selection.MoveRight Unit:=wdCharacter, Count:=1
Loop
SkipEmpty:
Next
doc.Close savechanges:=wdSaveChanges
Next i
MsgBox "处理完毕！共处理 " & .FoundFiles.Count & " 个文件！", vbOKOnly + vbExclamation, "循环遍历文件夹_查找重复标点符号"
Else
MsgBox "未发现文件！", vbOKOnly + vbCritical, "循环遍历文件夹_查找重复标点符号"
End If
End With
End Sub

复制代码

13907933959 · 发表于 2015-10-5 13:19

本帖最后由 13907933959 于 2015-10-6 07:18 编辑

413191246se 发表于 2015-10-4 21:01
139：我觉得现在还无法准确区分汉字/汉字标点符号及一些英文标点符号，所以，我觉得批量处理文档也不太好， ...

师傅、又不知怎么会事，回复的内容老是说要审查，几个小时都没有反应了。

13907933959 · 发表于 2015-10-5 17:55

本帖最后由 13907933959 于 2015-10-8 07:22 编辑

413191246se 发表于 2015-10-4 21:01
139：我觉得现在还无法准确区分汉字/汉字标点符号及一些英文标点符号，所以，我觉得批量处理文档也不太好， ...

师傅好！

由于今天上午来的病人比较多，比较忙，回复晚了请师傅见谅！

刚刚用35个文件试了 “循环遍历文件夹_查找重复标点符号”，的宏，总共耗时26分钟，准确率98左右％，好用！

师傅、我之所以要请你为我编写这个宏，主要是为了节省时间，如手工一个个查找再加修改没有个一、二年是很难完成，说句实话，我也不能总把时间耗在这整理资料上面，尽管这个对我以后也有帮助，毕竟主业不是这个，再说家里的经济也不允许这样长久的下去没有收入，所以我想尽快从这上面摆脱出来，回到主业上，还是网上哪句话说得好：“穷人最大的拦路虎是钱”，“富人最大的拦路虎是修养” 如果经济富裕的活，真想跟师傅你学这个。

师傅、不知怎么回事，每当你帮我编好一个宏后，我心里总有生命被延长的感觉，这也可能和我的职业有关，医生是通过自已的知识给病人延长生命、减轻痛苦，师傅你也是用自已的知识的帮助他人节省时间，不也是变相的延长了他人的生命、解除了他的烦恼吗？只是方式的不同。我觉得你的更高尚，你是无偿帮助他人。有了师傅的这个宏，有望在今年春节前把它们整理完，别外、我想利用这次机会，顺便把所有文档里面的这种括号()替换成这种括号（）

1、求师傅再编写几句替换括号的代码放在该宏里面。

2、求师傅再编写一个可单独使用的“循环遍历文件夹替换某个字及符号”的宏，如：可单独使用的“循环遍历文件夹将这种括号()替换成这种括号（）”，以便徒弟以后使用，徒弟拜谢师傅！

413191246se · 发表于 2015-10-6 14:28

* 139：过奖了！——建议批量处理不要太多，以免不响应。----下面是两个宏，看清宏名执行之，一般可以按 Alt+F8 找到所需宏双击或点击“运行”按钮，常用的也可以拖到工具栏上成为按钮，或设宏为热键F3/F4。

Sub 循环遍历文件夹_查找重复标点符号()
On Error Resume Next
Dim fd As FileDialog, i As Long, doc As Document, p As String, t As Long, s As Long, j As Paragraph
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then p = fd.SelectedItems(1) Else Exit Sub
Set fd = Nothing
If MsgBox("是否处理文件夹 " & p & " ?", vbYesNo + vbExclamation, "循环遍历文件夹_查找重复标点符号") = vbNo Then Exit Sub
With Application.FileSearch
.NewSearch
.LookIn = p
.SearchSubFolders = True
.FileName = "*.doc"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Set doc = Documents.Open(FileName:=.FoundFiles(i))
doc.Content.Find.Execute findtext:="(", ReplaceWith:="（", Replace:=wdReplaceAll
doc.Content.Find.Execute findtext:=")", ReplaceWith:="）", Replace:=wdReplaceAll
'查找重复标点符号
For Each j In doc.Paragraphs
j.Range.Select
If Len(j.Range) = 1 Then GoTo SkipEmpty
Selection.HomeKey Unit:=wdLine
Do
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
If Selection.Characters.Last Like vbCr Then GoTo SkipEmpty
If Selection.Characters.Last Like "[。；：，、！？;:,.?!…—]" Then
Do
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Loop Until Selection.Characters.Last Like "[!。；：，、！？;:,.?!…—]"
Selection.MoveEnd Unit:=wdCharacter, Count:=-1
If Len(Selection) > 1 And Not (Selection Like "……") And Not (Selection Like "——") Then
Selection.Font.Color = wdColorBlue '蓝色
' Selection.Range.HighlightColorIndex = wdBrightGreen '突出显示（鲜绿）
End If
End If
Selection.MoveRight Unit:=wdCharacter, Count:=1
Loop
SkipEmpty:
Next
doc.Close savechanges:=wdSaveChanges
Next i
MsgBox "处理完毕！共处理 " & .FoundFiles.Count & " 个文件！", vbOKOnly + vbExclamation, "循环遍历文件夹_查找重复标点符号"
Else
MsgBox "未发现文件！", vbOKOnly + vbCritical, "循环遍历文件夹_查找重复标点符号"
End If
End With
End Sub
Sub 循环遍历文件夹_替换英文括号为中文()
On Error Resume Next
Dim fd As FileDialog, i As Long, doc As Document, p As String, t As Long, s As Long, j As Paragraph
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then p = fd.SelectedItems(1) Else Exit Sub
Set fd = Nothing
If MsgBox("是否处理文件夹 " & p & " ?", vbYesNo + vbExclamation, "循环遍历文件夹_查找重复标点符号") = vbNo Then Exit Sub
With Application.FileSearch
.NewSearch
.LookIn = p
.SearchSubFolders = True
.FileName = "*.doc"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Set doc = Documents.Open(FileName:=.FoundFiles(i))
doc.Content.Find.Execute findtext:="(", ReplaceWith:="（", Replace:=wdReplaceAll
doc.Content.Find.Execute findtext:=")", ReplaceWith:="）", Replace:=wdReplaceAll
doc.Close savechanges:=wdSaveChanges
Next i
MsgBox "处理完毕！共处理 " & .FoundFiles.Count & " 个文件！", vbOKOnly + vbExclamation, "循环遍历文件夹_查找重复标点符号"
Else
MsgBox "未发现文件！", vbOKOnly + vbCritical, "循环遍历文件夹_查找重复标点符号"
End If
End With
End Sub

复制代码

13907933959 · 发表于 2015-10-7 08:45

本帖最后由 13907933959 于 2015-10-7 14:01 编辑

413191246se 发表于 2015-10-6 14:28
* 139：过奖了！——建议批量处理不要太多，以免不响应。----下面是两个宏，看清宏名执行之，一般可以按 Al ...

师傅好！
二个宏都非常好用，感谢师傅一次次为徒弟操劳！
师傅、这二个宏能不能再加几句代码，让它一次就可以处理文件夹内包含有子文件夹也有多个单个文件，文件夹内包含有子文件夹也有多个单个文件……。因我的文件大多是采用了这种方式的，如能处理这种，我就不用守在电脑前。

师傅、差一点忘了，还要劳你再编二句把文档内“手动换行符”替换成“段落标记”和把文档内“段落标记”替换成“手动换行符”的代码放在二个宏内。谢谢！

413191246se · 发表于 2015-10-7 14:07

139：循环遍历文件夹的程序，本身就包含在子文件夹中的文件了！
——还要劳你再编二句把文档内“手动换行符”替换成“段落标记”和把文档内“段落标记”替换成“手动换行符”的代码放在二个宏内——你这两个相反的动作，在一个宏里？那不是不如不做？

***将下面这句“手动换行符”替换为“段落标记”的代码
doc.Content.Find.Execute findtext:="^l", ReplaceWith:="^p", Replace:=wdReplaceAll
放到下面的代码下一行即可：
Set doc = Documents.Open(FileName:=.FoundFiles(i))

13907933959 · 发表于 2015-10-7 16:00

本帖最后由 13907933959 于 2015-10-7 16:01 编辑

413191246se 发表于 2015-10-7 14:07
139：循环遍历文件夹的程序，本身就包含在子文件夹中的文件了！
——还要劳你再编二句把文档内“手动换行 ...

师傅好！
循环遍历文件夹的程序，本身就包含在子文件夹中的文件了！
也可包括子文件夹外的多个单独文件吗？如是这样，我真是外行加笨！昨天晚上我一个文件夹、一个文件夹的弄，子文件夹外的多个单独文件，我还准备再装到一个文件夹再处理，我以为一次只能处理一个文件夹，不包括里面的子文件夹及子文件夹外的多个单独文件。唉、真是没知识、没文化，闹出了大笑活。

——二句把文档内 “手动换行符” 替换成 “段落标记” 和把文档内 “段落标记” 替换成 “手动换行符” 的代码放在二个宏内——你这两个相反的动作，在一个宏里？那不是不如不做？
我是想请师傅编写好，用的时侯分开用，我是怕这二句代码会有不同，师傅是不是说，二个引号内的 “手动换行符” 和 “段落标记” 换一下位就可以了？
徒弟的笨师傅是知道的，还请师傅点化！

413191246se · 发表于 2015-10-8 09:40

139：循环遍历文件夹，这个文件夹，已经包含无数层子文件夹了。第二个详见15楼。（手动换号符必须替换为段落标记，这样段落排版才能完成；而段落标记替换为手动换行符，一般时候不需要。

13907933959 · 发表于 2015-10-8 09:53

413191246se 发表于 2015-10-8 09:40
139：循环遍历文件夹，这个文件夹，已经包含无数层子文件夹了。第二个详见15楼。（手动换号符必须替换为段 ...

感谢师傅点化笨徒！师傅编写的几个宏、徒弟以经用上，现在是：咱老百姓啊！真呀真高兴呀，真呀真高兴！！！感谢师傅……！！！

13907933959 · 发表于 2015-10-10 10:23

413191246se 发表于 2015-10-8 09:40
139：循环遍历文件夹，这个文件夹，已经包含无数层子文件夹了。第二个详见15楼。（手动换号符必须替换为段 ...

师傅好！请看附件！

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

[求助] 求一个查找文档内多余的标点符号并把它们改为蓝色的宏代码