1000道选择题批量填入答案

zhanglei1371

还可以更快：

1. Sub 秒填答案_ByZL()
   
2. Dim arr, mh, strA$, i%, t
   
3.     t = Timer
   
4.     Set rng = ActiveDocument.Range
   
5.     strA = ActiveDocument.Range.Text
   
6.     With CreateObject("vbscript.regexp")
   
7.         .Global = True
   
8.         .Pattern = "(\d+)\.([A-Ea-e])(?=\W)"
   
9.         Set arr = .Execute(rng)
   
10.         .Pattern = "\([\u00A0]{3,}\)"
    
11.         For Each mh In .Execute(strA)
    
12.             strA = Replace(strA, mh, "( " & arr(i).submatches(1) & " )", , 1)
    
13.             i = i + 1
    
14.         Next
    
15.     End With
    
16.     ActiveDocument.Range.Text = strA
    
17.     MsgBox Timer - t
    
18. End Sub

复制代码

相见是缘8

kingtau 发表于 2019-12-2 12:42
经过月余的学习，将代码改进，现在只需要1.3秒就可以完成。

你好！
代码能运行吗？
我运行却提示“编译错误：方法和数据成员未找到”。 进代码窗口查看，显示这句 .Execute2007 代码有问题。

kingtau

相见是缘8 发表于 2019-12-3 07:31
你好！
代码能运行吗？
我运行却提示“编译错误：方法和数据成员未找到”。 进代码窗口查看，显示这句  ...

我的是word2016，运行正常。因为用正则换括号和空格会造成格式错乱，所以且了find。

kingtau

zhanglei1371 发表于 2019-12-2 23:30
还可以更快：

老师写的的确快0.3秒，到极致了
我用定义range的方式，主要是为了保证版式不变，但多了两个步骤：
先行替换空格由6个变成3个，三个空格中的一个被替换成答案的时候，后面的FirstIndex值才不会变。
表格也会造成FirstIndex改变，所以才会出现FirstIndex - 10的情况。
我写的有点曲线救国的意思，其实还是取舍不对，直接剪切表格，按老师的全正则代码，执行完再把表格粘贴回来也行。
针对本文还好，如果文档有多表格，就都不灵了，老师给个思路？谢谢

kingtau

相见是缘8 发表于 2019-12-3 07:31
你好！
代码能运行吗？
我运行却提示“编译错误：方法和数据成员未找到”。 进代码窗口查看，显示这句  ...

去掉2007也可以运行，官方文档里这两种方法都有，试了下执行效率一样。

相见是缘8

kingtau 发表于 2019-12-3 08:46
我的是word2016，运行正常。因为用正则换括号和空格会造成格式错乱，所以且了find。

我用的是 word 2003，去掉了2007可以了。
还有一个要请教你，代码是怎样判别那个才是正确答案的？

相见是缘8

kingtau 发表于 2019-12-3 09:26
去掉2007也可以运行，官方文档里这两种方法都有，试了下执行效率一样。

多谢提示！

zhanglei1371

kingtau 发表于 2019-12-3 09:22
老师写的的确快0.3秒，到极致了
我用定义range的方式，主要是为了保证版式不变，但多了两个步骤：
...

正则虽快，但只能针对文本，所以有表格的情况肯定不适用。
而且若是文中有域，有自动编号，此时正则会出现定位不准的情况，也不适用。

kingtau

相见是缘8 发表于 2019-12-3 10:52
我用的是 word 2003，去掉了2007可以了。
还有一个要请教你，代码是怎样判别那个才是正确答案的？

文档最后有参考答案啊，只是把答案移动到题干后面的括号里

相见是缘8

kingtau 发表于 2019-12-3 14:09
文档最后有参考答案啊，只是把答案移动到题干后面的括号里

啊，是这样呀！
由于你的文档较长，我上午只选用了前面的几十页，后面的删除了，没看到每题的正确答案，所以纳闷是怎样判别那个才是正确答案的。
谢谢！