怎样将题目下面对应答案和解析，自动对应到每一个题目后面。

wq52936064

怎样将题目下面对应答案和解析，自动对应到每一个题目后面。最近想看题复习 但是翻解析太麻烦了，求大神帮忙。最好能有教程。谢谢啦

duquancai

1. Sub shish()
   
2.     Dim Arg As Range, S$, mt, mh, arr(), brr(), n%, m%, i%
   
3.     Set Arg = ActiveDocument.Content
   
4.     With CreateObject("VBScript.Regexp")
   
5.         .Global = True: .IgnoreCase = True: .MultiLine = True
   
6.         .Pattern = "^\d+[^【】]+?A[^【】]+?D[^【】]+?\r"
   
7.         ReDim Preserve arr(1 To .Execute(Arg).Count)
   
8.         For Each mt In .Execute(Arg)
   
9.             n = n + 1
   
10.             arr(n) = mt
    
11.         Next
    
12.         Arg = .Replace(Arg, "")
    
13.         .Pattern = "^\d+."
    
14.         Arg = .Replace(Arg, "")
    
15.         .Pattern = "^[a-z]\s*(?:(?!^[a-z]\s*).)+"
    
16.         ReDim Preserve brr(1 To .Execute(Arg).Count)
    
17.         For Each mh In .Execute(Arg)
    
18.             m = m + 1
    
19.             brr(m) = mh
    
20.         Next
    
21.         Arg.Delete
    
22.     End With
    
23.     Selection.Text = "单项选择题" & Chr(13)
    
24.     Selection.Collapse wdCollapseEnd
    
25.     For i = 1 To UBound(arr)
    
26.         S = S & arr(i) & "正确答案为：" & brr(i)
    
27.     Next
    
28.     Selection.Text = S
    
29.     Selection.HomeKey
    
30. End Sub
    

复制代码

wq52936064

duquancai 发表于 2016-8-30 20:19

谢谢 成功了·····真的谢谢···

wq52936064

wq52936064 发表于 2016-8-31 00:29
谢谢 成功了·····真的谢谢···

请问一下 如果是 多项选择题的话 怎么办楠，模板和上面那个文件基本相同

tangqingfu

duquancai 发表于 2016-8-30 20:19

谢谢杜老师的分享！