如何用VBA查找特定格式的字符串，并复制到文章的尾部

pbdq

我的一篇文章，有大量类似 (),(我) 这样格式的文字，我想用vba，把所有此类的文字，查找出来，并全部复制，添加到文章的结尾，结果不行。


请大神帮忙看看。（似乎查找的工作没有执行）


用通配符，手工查找是可以的。

1.     Selection.WholeStory
   
2.     Selection.Find.ClearFormatting
   
3.     With Selection.Find
   
4.         .Text = "\(\)\,(?)"
   
5.         .Replacement.Text = ""
   
6.         .Forward = True
   
7.         .Wrap = wdFindAsk
   
8.         .Format = False
   
9.         .MatchCase = False
   
10.         .MatchWholeWord = False
    
11.         .MatchByte = False
    
12.         .MatchAllWordForms = False
    
13.         .MatchSoundsLike = False
    
14.         .MatchWildcards = True
    
15.     End With
    
16.     Selection.Copy
    
17.     Selection.WholeStory

复制代码

413191246se

楼主，请提供样例附件才好。。。

pbdq

这个是测试用的文件。

xwdys

是这个意思吗？
Sub test()
    Dim reg, k, m, n, str$
    str = ActiveDocument.Content
    Set reg = CreateObject("vbscript.regexp")
    reg.Pattern = "\([a-zāáǎàōóǒòēéěèīíǐìūúǔùǖǘǚǜüêńň?ɑɡ]{1,6}\),[一-龥]{1}"
    reg.Global = True
    Set m = reg.Execute(str)
    For Each n In m
        Selection.EndKey wdStory
        Selection.Text = n.Value & vbCrLf
    Next
End Sub

pbdq

xwdys 发表于 2015-4-22 12:41
是这个意思吗？
Sub test()
    Dim reg, k, m, n, str$

和这个很类似了。

只是，我要求，这个字后面括号里面的拼音，格式是红色的

只是想把格式是红色的复制出来啊。

xwdys

再试一下：
Sub test()
    Dim i&, j&, rng As Range
    Dim arr(1000)               '*****
   
    i = 0
    Selection.HomeKey wdStory
   
    With Selection.Find
        .ClearFormatting
        .Text = "[a-zā-ɡ]{1,6}"
        .MatchWildcards = True
        .Font.ColorIndex = wdRed
        .Forward = True
        Do While .Execute
            Set rng = Range(Start:=Selection.Start, End:=Selection.End + 3)
            arr(i) = rng
            i = i + 1
        Loop
   
        j = UBound(arr)
        For i = 0 To j
            If arr(i) = "" Then Exit For
            Selection.EndKey wdStory
            Selection.Text = "(" & arr(i) & vbCrLf
        Next
   End With
End Sub

pbdq

xwdys 发表于 2015-4-23 16:44
再试一下：
Sub test()
    Dim i&, j&, rng As Range

我执行的时候，这句话过不去

Set rng = Range(Start:=Selection.Start, End:=Selection.End + 3)


显示 过程或者函数未定义。 可能是  Range的问题

pbdq

xwdys 发表于 2015-4-23 16:44
再试一下：
Sub test()
    Dim i&, j&, rng As Range

谢谢。似乎修改成

Set rng = ActiveDocument.Range(Start:=Selection.Start, End:=Selection.End + 3)

这样就可以啦。

xwdys

sorry,我把代码放在ThisDocument中测试,所以省略了

pbdq

xwdys 发表于 2015-4-25 21:08
sorry,我把代码放在ThisDocument中测试,所以省略了

非常谢谢。

我们是用来做佛经注音校对的。感恩你。以后可能还有很多需要向你请教的。