批量选择性复制

wordaaaaa

请教各位 怎样批评将所有的中文文章信息区后的网址这一段复制到英文信息区后面  具体请看图片 谢谢咯~~

hhjjpp

1. Sub Macro4()
   
2.     Selection.HomeKey Unit:=wdStory                            '不能添加监视Selection.Find.Execute，否则相当于在执行一次查找，即使不在本模块也不行
   
3.     With Selection.Find
   
4.         .ClearFormatting
   
5.         .MatchWildcards = True
   
6.         .Text = "[一-﨩]*^13"
   
7.         .Forward = True
   
8.         Do While .Execute
   
9.            Selection.MoveRight Unit:=wdCharacter, Count:=1     '添加监视Selection.Range.Text
   
10.            Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    
11.            If Left(Selection.Range.Text, 7) = "http://" Then
    
12.               netd = Selection.Range.Text
    
13.               Selection.MoveRight Unit:=wdCharacter, Count:=1
    
14.               Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    
15.               netd = netd & IIf(Left(Selection.Range.Text, 7) = "http://", Selection.Range.Text, "")
    
16.               Selection.MoveDown Unit:=wdParagraph, Count:=1
    
17.               .Text = "[a-zA-Z]"
    
18.               .MatchWildcards = True
    
19.               .Execute
    
20.               Selection.MoveRight Unit:=wdCharacter, Count:=1
    
21.               Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    
22.               Selection.MoveDown Unit:=wdLine, Count:=1
    
23.               Selection.InsertAfter netd
    
24.               Selection.MoveRight Unit:=wdCharacter, Count:=1
    
25.               .Text = "[一-﨩]*^13"
    
26.               .MatchWildcards = True
    
27.             Else
    
28.               Selection.MoveDown Unit:=wdParagraph, Count:=1
    
29.             End If
    
30.          Loop
    
31.     End With
    
32. End Sub

复制代码

kqbt

测试下列操作之前，请自行备份好原文档。
Ctrl + H
查找内容：

1. ([一-﨩]*^13)(http://[!^13]{1,}^13)(*^13)(^13{2,})

复制代码

替 换 为：

1. \1\3\2\4

复制代码

√ 使用通配符 → 全部替换

kqbt

如果有部分网址已经在正确的位置，那么建议测试：
查找内容：

1. ([一-﨩]*^13)(http://[!^13]{1,}^13)([!一-﨩]@^13)(^13{2,})

复制代码

替 换 为：

1. \1\3\2\4

复制代码

duquancai

1. Sub shishi()
   
2.     With CreateObject("vbscript.regexp")
   
3.         .Global = True: .IgnoreCase = False: .MultiLine = True
   
4.         .Pattern = "^(http://.+?)$^(.+?\(\d+\):\s*\d+-\d+)$"
   
5.         ActiveDocument.Content.Text = .Replace(ActiveDocument.Content.Text, "$2" & vbCr & "$1")
   
6.     End With
   
7. End Sub

复制代码

wordaaaaa

hhjjpp 发表于 2016-7-20 08:07

您好  代码很棒！ 但其实我是想复制到带有“Shijie Huaren Xiaohua Zazhi”这一段的后面，不是复制到下一段的后面哟~  您有时间再麻烦改一下~~ 谢谢啦

wordaaaaa

duquancai 发表于 2016-7-20 12:09

您好  我是想复制的啦  您这段代码执行后是移动过去了，有空您改一下啦~  谢谢啦！

wordaaaaa

kqbt 发表于 2016-7-20 10:11
如果有部分网址已经在正确的位置，那么建议测试：
查找内容：
替 换 为：

您好  我是想把那一部分网址复制到下面，这样不能复制啊。。。

wordaaaaa

duquancai 发表于 2016-7-20 12:09

拜托拜托大神啦  有空帮忙修改一下哦  谢谢~谢谢~