word批量查找替换

3701漂

我想把文章中《》里面的内容查找出来并标红，如果找不到，则不做任何处理。有哪位老师能帮帮我

13907933959

占个座。

413191246se

楼主，前5段就是你要的，手动选定吧！（139也在）

13907933959

413191246se 发表于 2016-5-16 09:46
楼主，前5段就是你要的，手动选定吧！（139也在）

师傅好！

这个“选取颜色字段”的代码，是在网上找到的，它只能选中文档内的第一段红色的文字，想请师傅把它改为可选中文档内所有的红色文字。

另外、劳请师傅再编写一个把红色的内容，提取到另一个空白文档内的宏。


Sub 选取颜色字段()
  Dim myRange As Range
  Set myRange = ActiveDocument.Content
  With myRange.Find
     .Format = True
     .Font.Color = wdColorRed
     If .Execute = True Then myRange.Paragraphs(1).Range.Select
  End With
End Sub

413191246se

139：选中文档内所有的红色文字——这个我不会写代码，你可以用“查找”格式红色文字来办到，但其实可以分别找到红色文字。第二个要求请见下面的宏：

1. Sub 查找红色文字提取到空白文档()
   
2.     Dim i As String, doc As Document, j As Long
   
3.     i = ActiveDocument.Name
   
4.     Set doc = Documents.Add
   
5.     Documents(i).Activate
   
6.     Selection.HomeKey Unit:=wdStory
   
7.     Do
   
8.         With Selection.Find
   
9.             .ClearFormatting
   
10.             .Font.Color = wdColorRed
    
11.             .Execute
    
12.             If Selection.Find.Found = True Then
    
13.                 Selection.Copy
    
14.                 Documents(doc).Activate
    
15.                 Selection.Paste
    
16.                 doc.Characters(1).Copy
    
17.                 Selection.TypeParagraph
    
18.                 Documents(i).Activate
    
19.                 j = 1
    
20.             End If
    
21.         End With
    
22.     Loop Until Selection.Find.Found = False
    
23.     If j = 1 Then
    
24.         Documents(i).Close savechanges:=wdDoNotSaveChanges
    
25.         doc.Paragraphs.Last.Range.Delete
    
26.         MsgBox "提取完毕！文档尚未保存！", vbOKOnly + vbCritical, "查找和替换"
    
27.     Else
    
28.         doc.Close
    
29.         MsgBox "未找到红色文字！", vbOKOnly + vbCritical, "查找和替换"
    
30.     End If
    
31. End Sub

复制代码

13907933959

413191246se 发表于 2016-5-19 10:05
139：选中文档内所有的红色文字——这个我不会写代码，你可以用“查找”格式红色文字来办到，但其实可以分 ...

师傅好！
代码刚测试了，在有红色字段的附件上正常运行完，但不知道什么原因，显示的却是：“未找到红色文字”， 提取不了，请师傅再看看。

413191246se

139：查找和替换的VBA我搞不好，重新修改了一下，这回似乎没问题了！你试试吧！

1. Sub 查找红色文字提取到空白文档()
   
2.     Dim i As String, doc As Document, j As Long
   
3.     i = ActiveDocument.Name
   
4. recome:
   
5.     Selection.HomeKey Unit:=wdStory
   
6.     Do
   
7.         With Selection.Find
   
8.             .ClearFormatting
   
9.             .Font.Color = wdColorRed
   
10.             .Execute
    
11.             If Selection.Find.Found = True Then
    
12.                 If j = 1 Then GoTo conti
    
13.                 '
    
14.                 Selection.EndKey Unit:=wdStory
    
15.                 Selection.TypeParagraph
    
16.                 Selection.TypeText Text:="速413191246se结"
    
17.                 Selection.Paragraphs(1).Range.Select
    
18.                 Selection.Font.Color = wdColorRed
    
19.                 '
    
20.                 Set doc = Documents.Add
    
21.                 Documents(i).Activate
    
22.                 j = 1
    
23.                 GoTo recome
    
24. conti:
    
25.                 If Selection.Text = "速413191246se结" & vbCr Then
    
26.                     ActiveDocument.Close savechanges:=wdDoNotSaveChanges
    
27.                     doc.Paragraphs.Last.Range.Delete
    
28.                     MsgBox "提取完毕！文档尚未保存！", vbOKOnly + vbExclamation, "查找和替换": End
    
29.                 End If
    
30.                 Selection.Copy
    
31.                 Documents(doc).Activate
    
32.                 Selection.Paste
    
33.                 doc.Characters(1).Copy
    
34.                 Selection.TypeParagraph
    
35.                 Documents(i).Activate
    
36.             Else
    
37.                 ActiveDocument.Close savechanges:=wdDoNotSaveChanges
    
38.                 MsgBox "未找到红色文字！", vbOKOnly + vbCritical, "查找和替换": End
    
39.             End If
    
40.         End With
    
41.     Loop Until Selection.Find.Found = False
    
42. End Sub

复制代码

3701漂

413191246se 发表于 2016-5-19 16:17
139：查找和替换的VBA我搞不好，重新修改了一下，这回似乎没问题了！你试试吧！

谢谢各位的帮忙，问题已经解决，谢谢啦

13907933959

413191246se 发表于 2016-5-19 16:17
139：查找和替换的VBA我搞不好，重新修改了一下，这回似乎没问题了！你试试吧！

师傅好！

这个是可以提取了，但在提取完后，会弹出一个“运行错误”的提示，到代码窗口内发现这句doc.Paragraphs.Last.Range.Delete代码被黄颜色盖住了，不知是什么原因，请师傅再看看。

413191246se

139：将此句注释掉，即在其行前面加个小撇号'试试（此语句意为删除空白文档中最后一段，实际上只有一个回车符）。