单位培训有一WORD题库，想做成能随机抽题的题库，不知怎么做？

zjg303

1、[题号：1；鉴定点：AAA001；选择题；题分：1；难度：3；一致性：5]
凡是有连通孔隙、裂缝或溶洞，能使油气储存，并在其中渗滤的岩层称为(    )。
（A）储集岩  （B）油气藏  （C）储集层  （D）断层
答文：C
2、[题号：2；鉴定点：AAA001；选择题；题分：1；难度：3；一致性：5]
不利于油气储集的构造是(    )。
（A）岩性尖灭  （B）断块圈闭  （C）背斜圈闭  （D）向斜露头
答文：D
3、[题号：3；鉴定点：AAA001；选择题；题分：1；难度：3；一致性：5]
通常储藏丰富油气的是(    )地质构造。
（A）背斜圈闭  （B）向斜圈闭  （C）单斜圈闭  （D）双斜圈闭
答文：A
4、[题号：4；鉴定点：AAA001；选择题；题分：1；难度：3；一致性：5]
常见的构造油气藏有背斜油气藏(    )等。
（A）砂岩油气藏  （B）断层油气藏  （C）地层油气藏  （D）古潜山油气藏
答文：B
5、[题号：5；鉴定点：AAA001；判断题；题分：1；难度：3；一致性：5]
常储藏丰富油气的是向斜地质构造。
答文：×；正确答案：常储藏丰富油气的是背斜圈闭地质构造。
6、[题号：6；鉴定点：AAA001；判断题；题分：1；难度：3；一致性：5]
储集层有两个重要的特性—孔隙性和渗透性。
答文：√
7、[题号：7；鉴定点：AAA001；判断题；题分：1；难度：3；一致性：5]
若储集层中以含油为主，则称为含油层。
答文：√
8、[题号：8；鉴定点：AAA002；选择题；题分：1；难度：3；一致性：5]
根据流体是否在孔隙中流动，可将孔隙分为(    )孔隙和(    )孔隙。
（A）大、小  （B）有效、无效  （C）连通、不连通  （D）毛细管、超毛细管
答文：B
9、[题号：9；鉴定点：AAA002；选择题；题分：1；难度：3；一致性：5]
目前石油企业广泛采用的饱和流体法和气体孔隙度仪测定的均是岩石的(    )孔隙度。
（A）无效  （B）绝对  （C）有效  （D）流动
答文：C
10、[题号：10；鉴定点：AAA002；选择题；题分：1；难度：3；一致性：5]
岩石渗透性的大小用渗透率来表示，它可以利用(    )来测定。
（A）欧姆定律  （B）万有引力定律  （C）动是守恒定律  （D）达西定律
答文：D
11、[题号：11；鉴定点：AAA002；选择题；题分：1；难度：3；一致性：5]
压裂设计中油气层物性常用(    )声波时差，含水饱和度和油层等参数来描述。
（A）孔隙度  （B）射孔数  （C）固井质量  （D）人工井底
答文：A
12、[题号：12；鉴定点：AAA002；判断题；题分：1；难度：3；一致性：5]
油气储集层的两个特性是孔隙性和渗透性。
答文：√

zjg303

自己顶起，没有人看到吗？现在用WORD VBA的越来越少了。都专注于EXCEL VBA了。

huanger999

1、        在题库的最前面增加一个回车。
2、        Ctrl+H呼出替换窗口，查找“^p”，替换为“^l”，点击“全部替换”；查找“^l^#、”，替换为“^p”，点击“全部替换”；查找“^l^#^#、”，替换为“^p”，点击“全部替换”；查找“^l^#^#^#、”，替换为“^p”，点击“全部替换”；查找“^l答文”，替换为“^p答文”。
3、        删除最前面的空行
4、        保存文件名为“题库2”，这个文件中，奇数段为题目，偶数段为答案，题目与答案相连。
5、        新建一个文件，输入三~四个回车，保存文件名为“考题”
6、        运行下面的宏

1. Sub myrandom()
   
2. Dim temp1(99) As Integer '如果题库的体量大于100，那么列表长度也要相应扩大
   
3. intmin = 1 '题库，从1号题目开始选
   
4. intmax = 100 '题库，最大题号为100
   
5. intnum = 10  '从中选择多少道题
   
6. intnow = 0
   
7. '以下为产生不重复的intnum个题号，新产生的题号再列表的末端
   
8. For i = intmin To intmax
   
9. temp1(i - intmin) = i
   
10. Next
    
11. 
    
12. For j = 0 To intnum - 1
    
13. introm = (intmax - intmin + 1 - j) * Rnd()
    
14. a = temp1(intmax - intmin - j)
    
15. temp1(intmax - intmin - j) = temp1(introm)
    
16. temp1(introm) = a
    
17. Next
    
18. 
    
19. '以下为生成考题
    
20. For j = 0 To intnum - 1
    
21. intcur = temp1(intmax - intmin - j)
    
22. Documents("题库2").Paragraphs(2 * intcur - 1).Range.Select
    
23. Selection.Copy
    
24. Documents("考题").Paragraphs(j + 1).Range.Select
    
25. Selection.HomeKey Unit:=wdLine
    
26. Selection.TypeText CStr(j + 1) & "、"
    
27. Selection.Paste
    
28. 
    
29. Documents("题库2").Paragraphs(2 * intcur).Range.Select
    
30. Selection.Copy
    
31. Documents("考题").Paragraphs(j + 1).Range.Select
    
32. Selection.EndKey Unit:=wdStory
    
33. Selection.TypeText CStr(j + 1) & "、"
    
34. Selection.Paste
    
35. 
    
36. Next
    
37. 
    
38. End Sub

复制代码

考题.zip (11.27 KB, 下载次数: 297)

2014-3-17 20:11 上传

点击文件名下载附件

zjg303

试了一下，不知为什么  ^l  这个符号查找替换里不能用？

huanger999

后面是字母L的小写。是把段落换成换行符。把我转化后的题库贴在这里。 题库2.zip (32.2 KB, 下载次数: 279)

2014-3-19 08:57 上传

点击文件名下载附件

对不起，在步骤2的前面少了一个步骤。见红色字的部分。我在上面的帖子里面也进行了修改。

2、        Ctrl+H呼出替换窗口，查找“^p”，替换为“^l”，点击“全部替换”；查找“^l^#、”，替换为“^p”，点击“全部替换”；查找“^l^#^#、”，替换为“^p”，点击“全部替换”；查找“^l^#^#^#、”，替换为“^p”，点击“全部替换”；查找“^l答文”，替换为“^p答文”。

zjg303

已试验通过了，谢谢huanger999，如果能把前面查找替换的步骤也写进VBA代码就更好了。

huanger999

zjg303 发表于 2014-3-21 09:22
已试验通过了，谢谢huanger999，如果能把前面查找替换的步骤也写进VBA代码就更好了。

呵呵，这个自己录制宏就好了。我也是临时想到这样处理比较方便。

zjg303

运行时发现了个问题，就是随机选了几次出的题都是一样的，没有达到随机选题的效果。

zjg303

加了一条语句，就能达到随机选题了：randomize
Sub myrandom()
Dim temp1(99) As Integer '如果题库的体量大于100，那么列表长度也要相应扩大
intmin = 1 '题库，从1号题目开始选
intmax = 100 '题库，最大题号为100
intnum = 10  '从中选择多少道题
intnow = 0
'以下为产生不重复的intnum个题号，新产生的题号再列表的末端
For i = intmin To intmax
temp1(i - intmin) = i
Next
randomize
For j = 0 To intnum - 1
introm = (intmax - intmin + 1 - j) * Rnd()
a = temp1(intmax - intmin - j)
temp1(intmax - intmin - j) = temp1(introm)
temp1(introm) = a
Next

'以下为生成考题
For j = 0 To intnum - 1
intcur = temp1(intmax - intmin - j)
Documents("题库2").Paragraphs(2 * intcur - 1).Range.Select
Selection.Copy
Documents("考题").Paragraphs(j + 1).Range.Select
Selection.HomeKey Unit:=wdLine
Selection.TypeText CStr(j + 1) & "、"
Selection.Paste

Documents("题库2").Paragraphs(2 * intcur).Range.Select
Selection.Copy
Documents("考题").Paragraphs(j + 1).Range.Select
Selection.EndKey Unit:=wdStory
Selection.TypeText CStr(j + 1) & "、"
Selection.Paste

Next

End Sub

zjg303

huanger999 发表于 2014-3-21 09:37
呵呵，这个自己录制宏就好了。我也是临时想到这样处理比较方便。

你好，如何把题库里的选择题和判断题分开，我写的代码不能实现。还得请教你呀。