大家好，word文档中选择题，想把四行变成一行

aiyushx

我想把一个word文档里的选择题，因为他是ABCD四个选择，现在是分四行，我想换成一行，

已读，并且把答案放在题目的后面。

这是原排版：

      要达成的效果：            


        谁能帮助我一下，谢谢大家了。这是原版word文档
      
   
理论考核题库 11 文本.zip (141.14 KB, 下载次数: 49)

2019-11-25 16:36 上传

点击文件名下载附件
原版题库

kingtau

提出几页调试，一切正常。
原文件试运行了一下，效率太低，189页文件用时13分钟
继续改进用正则，还在学习中

1. Sub 选择题归一()
   
2. Dim i%, t$, ti
   
3. With ActiveDocument
   
4.     .Content = StrConv(.Content, vbNarrow)
   
5.         For i = .Paragraphs.Count To 1 Step -1
   
6.             With .Paragraphs(i)
   
7.                 If Len(.Range) < 4 Or .Range Like "—*" Then
   
8.                     .Range.Delete
   
9.                 ElseIf .Range Like "[ABCD]*" Then
   
10.                     .Range.Characters(1).InsertAfter ". "
    
11.                     .Range = Replace(.Range, Chr(13), vbTab)
    
12.                 ElseIf .Range Like "答案*" Then
    
13.                     t = Replace(.Range, Chr(13), "")
    
14.                     .Range = vbCr
    
15.                 ElseIf .Range Like "[0-9]*" And t <> "" Then
    
16.                     .Range = Replace(.Range, Chr(13), t & Chr(13))
    
17.                     t = ""
    
18.                 End If
    
19.             End With
    
20.         Next
    
21. End With
    
22. End Sub

复制代码

zhanglei1371

勾选通配符：
1.查找—[ １２３４５６７８９０]@—，替换为空；
2.查找^13([ １２３４５６７８９０]@)替换为^p★ZL★
3.查找^13，替换为空；
4.查找）(Ａ*)(答案：[ＡＢＣＤＥ])替换为）\2^p\1
5.查找[★ZL★]{1,}，替换为^p
6.查找(答案：[ＡＢＣＤＥ])([ＡＢＣＤＥ])，替换为\1^p\2

daibao88

先查找替换一次干掉空行，再循环判断段落，速度会好些

tcdatongye

经过三次查找替换
1、^t
  '两空格
2、([０-９Ａ-Ｅ]{1,}?*)^13
\1  '加两空格
3、([０-９]{1,}*）)  (*)  (答案：[Ａ-Ｅ])(^13)
\1^t\3^p\2\4
你的文档有的括号后面有答案了，不知为什么要这样写？这里仅操作括号后没答案的。

kingtau

经过几天的研究，做出了改进，以全正则表达式的方式排版
经测试全文档用时8.8秒

1. Sub 全正则整理文档()
   
2.     Dim rng As Range
   
3.         ActiveDocument.Content = StrConv(ActiveDocument.Content, vbNarrow)
   
4.         Set rng = ActiveDocument.Content
   
5.     With CreateObject("vbscript.regexp")
   
6.         .Global = True
   
7.         .MultiLine = True
   
8.         .Pattern = "(^—.{4,6}\r)|(^\s*\r)"                                 '删除空段
   
9.         rng = .Replace(rng, "")
   
10.         .Pattern = "\([\s\t]\)"                                                      '替换括号
    
11.         rng = .Replace(rng, "(   )")
    
12.         .Pattern = "(^\d.{1,90}?)\((\s{3})\).??答案:(.{1,5})$"     '已填好的答案入括号
    
13.         rng = .Replace(rng, "$1( $3 )")
    
14.         .Pattern = "(^\d.{1,90}?)\((\s{3})\)(.*?)答案:(.{1,5})$"  '未填的答案入括号
    
15.         rng = .Replace(rng, "$1( $4 )$3")
    
16.         .Pattern = "(^\d.*?)(\r)"                                                 '题干前加空行
    
17.         rng = .Replace(rng, "$2$1$2")
    
18.         .Pattern = "(^[ABCDE].*?)(\r)"                                      '选项合一
    
19.         rng = .Replace(rng, "$1  ")
    
20.         .Pattern = "(^—.{4,6}\r)|(^\s*\r)"                                 '删除空段
    
21.         rng = .Replace(rng, "")
    
22.     End With
    
23. End Sub

复制代码

kingtau

经过改进，1.9秒就可以完成

1. Sub 全正则整理文档()
   
2.     Dim rng, t
   
3.     t = Timer
   
4.         ActiveDocument.Content = StrConv(ActiveDocument.Content, vbNarrow)
   
5.         rng = ActiveDocument.Content
   
6.     With CreateObject("vbscript.regexp")
   
7.         .Global = True
   
8.         .MultiLine = True
   
9.         .Pattern = "(^—.{4,6}\r)|(^\s*\r)"                                 '删除空段
   
10.         rng = .Replace(rng, "")
    
11.         .Pattern = "\([\s\t]\)"                                                      '替换括号
    
12.         rng = .Replace(rng, "(   )")
    
13.         .Pattern = "(^\d.{1,90}?)\((\s{3})\).??答案:(.{1,5})$"     '已填好的答案入括号
    
14.         rng = .Replace(rng, "$1( $3 )")
    
15.         .Pattern = "(^\d.{1,90}?)\((\s{3})\)(.*?)答案:(.{1,5})$"  '未填的答案入括号
    
16.         rng = .Replace(rng, "$1( $4 )$3")
    
17.         .Pattern = "(^\d.*?)(\r)"                                                 '题干前加空行
    
18.         rng = .Replace(rng, "$2$1$2")
    
19.         .Pattern = "(^[ABCDE].*?)(\r)"                                      '选项合一
    
20.         rng = .Replace(rng, "$1  ")
    
21.         .Pattern = "(^—.{4,6}\r)|(^\s*\r)"                                 '删除空段
    
22.         rng = .Replace(rng, "")
    
23.     End With
    
24.     ActiveDocument.Content = rng
    
25.     MsgBox Timer - t
    
26. End Sub

复制代码

任我小行

kingtau 发表于 2019-12-8 09:40
经过改进，1.9秒就可以完成

请问这些代码怎么用啊？

菜鸟问一句