如何把第一个word文档变成第二个文档格式变成简版答案

不羁的海

请各位高手帮忙看看，如何把第一个word文档变成第二个文档格式便于看答案，谢谢大神！

不羁的海

kingtau 发表于 2019-12-7 23:53
改进版，可提速数倍。

万分感谢！真是解决了大问题！再次感谢！

不羁的海

不羁的海

也就是把图一格式文档，变成图二格式文档

不羁的海

大神有会处理的吗？帮帮忙

kingtau

大致还算有规律。
就是答案位置不固定，本身也还是新手（正在学习正则表达式），这步多花了点时间。
有的答案在段首，有的在段中，有的在段尾。

此代码已整理好结果，未排序和分类，在答案选项前特意留了个空格，方便文本转表格
word自身带排序功能，排序和分类自己搞吧

1. Sub 选择题取答案()
   
2. Dim rng As Range, m As Long, n As Long
   
3.     Set rng = ActiveDocument.Content
   
4.     With CreateObject("vbscript.regexp")
   
5.         .Global = True
   
6.         .MultiLine = True
   
7.         .Pattern = "^\D.*?\r"
   
8.         rng = .Replace(rng, "") '剔除所有不是数字序号开头的段落
   
9.         .Pattern = "^\d+|[ “”《》:；：?？．、，。\.]"
   
10.         rng = .Replace(rng, "") '剔除所有干扰结果的标点符号
    
11.         .Pattern = "\(\)|（）"
    
12.         rng = .Replace(rng, "") '剔除无关的空括号
    
13.         .Pattern = "(^.*?)[\(|（]([ABCDE×√]+)[\)|）](.*?)(\r)"
    
14.         rng = .Replace(rng, "$1$3$2$4") '将答案移动至段尾
    
15.         .Pattern = "(..).*?(..)([ABCDE×√]+)(\r)"
    
16.         rng = .Replace(rng, "$1..$2 $3$4") '段落首尾（除答案外）各保留两个字符
    
17.         .Pattern = "\r\s*\r"
    
18.         rng = .Replace(rng, "") '删除空段
    
19.     End With
    
20. End Sub

复制代码

kingtau

忘记提醒，请新建副本，不要在原始文件上操作，切记！

kingtau

改进版，可提速数倍。

1. Sub 选择题取答案()
   
2. Dim rng$, t
   
3. t = Timer
   
4.     rng = ActiveDocument.Content
   
5.     With CreateObject("vbscript.regexp")
   
6.         .Global = True
   
7.         .MultiLine = True
   
8.         .Pattern = "^\D.*?\r"
   
9.         rng = .Replace(rng, "") '剔除所有不是数字序号开头的段落
   
10.         .Pattern = "^\d+|[ “”《》:；：?？．、，。\.]"
    
11.         rng = .Replace(rng, "") '剔除所有干扰结果的标点符号
    
12.         .Pattern = "\(\)|（）"
    
13.         rng = .Replace(rng, "") '剔除无关的空括号
    
14.         .Pattern = "(^.*?)[\(|（]([ABCDE×√]+)[\)|）](.*?)(\r)"
    
15.         rng = .Replace(rng, "$1$3$2$4") '将答案移动至段尾
    
16.         .Pattern = "(..).*?(..)([ABCDE×√]+)(\r)"
    
17.         rng = .Replace(rng, "$1..$2 $3$4") '段落首尾（除答案外）各保留两个字符
    
18.         .Pattern = "\r\s*\r"
    
19.         rng = .Replace(rng, "") '删除空段
    
20.     End With
    
21.     ActiveDocument.Content = rng
    
22.     MsgBox "共用时 " & Timer - t & " 秒"
    
23. End Sub

复制代码

不羁的海

kingtau 发表于 2019-12-7 22:28
大致还算有规律。
就是答案位置不固定，本身也还是新手（正在学习正则表达式），这步多花了点时间。
有的 ...

排序可以自己做！谢谢！

不羁的海

又回看了一次你的代码，太感谢了