求助：将选择题的答案依次填入每个题干后面的问题？

绝世偏执狂

想要将文档最后的答案依次放到每个题目的最后 因为之前只会在WPS文字上录制宏 所以思路是根据那个来的 最近发现有时候宏不够用 文档过大的时候用录制的宏修改过的代码经常卡死  又下载了office2016 用了一下发现有些地方跟WPS不通用 录了两个宏发现都时灵时不灵 而且文档过大的时候 一样卡死 。自学了几天vba 连入门都没有入门 因此特来求助论坛的朋友。

tcdatongye

1. Sub 查找替换()
   
2. Set dic = VBA.CreateObject("scripting.dictionary")
   
3. Set reg = VBA.CreateObject("vbscript.regexp")
   
4. Selection.StartOf unit:=wdStory
   
5. With Selection.Find
   
6.   .Wrap = wdFindStop
   
7.   .Text = "答案"
   
8.   If .Execute = False Then
   
9.     MsgBox "没有答案"
   
10.     Exit Sub
    
11.   End If
    
12.   Set rng = .Parent
    
13.   rng.EndOf unit:=wdStory, Extend:=wdExtend
    
14.     ss = rng
    
15.     rng.Delete
    
16.   With reg
    
17.   .Global = True
    
18.   .ignorecase = True
    
19.   .Pattern = "(\d+).*?([a-z])"
    
20.   Set ss = .Execute(ss)
    
21.   For Each mm In ss
    
22.      dic(mm.submatches(0)) = mm.submatches(1)
    
23.   Next
    
24.   End With
    
25. End With
    
26. Selection.EndOf unit:=wdStory
    
27. With Selection.Find
    
28.   .MatchWildcards = True
    
29.   .Forward = False
    
30.   .Wrap = wdFindStop
    
31.   .Text = "[0-9]{1,}.*[A-Z]."
    
32.   Do While .Execute
    
33.     Set rng = .Parent
    
34.     arr = Split(rng, ".")(0)
    
35.     rng.EndOf unit:=wdLine, Extend:=wdExtend
    
36.     rng.End = rng.End - 1
    
37.     rng.InsertAfter vbCrLf & "答案：" & dic(arr)
    
38.      rng.Collapse
    
39.    Loop
    
40. End With
    
41. Set dic = Nothing
    
42. Set reg = Nothing
    
43. End Sub
    

复制代码

绝世偏执狂

tcdatongye 发表于 2019-11-11 19:35

膜拜大佬！牛！

wdpfox

学习中，谢谢tcdatongye分享代码！

                                        莫愁前路无知己，天下谁人不识君！只道是：海内存知己，天涯若比邻！