如何实现定制选择题答案

zhanglei1371

示例题目如下：可看到答案是不规则的，若果想要题目答案批量变成ABCDABCD......的形式，该如何写程序？（题目很多，这样的好处是出试卷时直接设计一个答案序列，便于改卷）

1、下列叙述错误的是  答案：B

A、生物药剂学是研究药物在体内的吸收、分布、代谢与排泄的机理及过程的边缘科学

B、大多数药物通过被动扩散方式透过生物膜

C、主动转运是一些生命必需的物质和有机酸、碱等弱电解质的离子型等，借助载体或酶促系统从低浓度区域向高浓度区域转运的过程

D、被动扩散一些物质在细胞膜载体的帮助下，由高浓度向低浓度区域转运的过程

E、细胞膜可以主动变形而将某些物质摄入细胞内或从细胞内释放到细胞外，称为胞饮

2、不是药物通过生物膜转运机理的是答案：E

A、主动转运    B、促进扩散    C、渗透作用    D、胞饮作用    E、被动扩散

3、以下哪条不是被动扩散特征答案：C

A、不消耗能量    B、有部位特异性    C、由高浓度区域向低浓度区域转运

D、不需借助载体进行转运    E、无饱和现象和竞争抑制现象

4、以下哪条不是主动转运的特征  答案：C

A、消耗能量    B、可与结构类似的物质发生竞争现象    C、由低浓度向高浓度转运

D、不需载体进行转运    E、有饱和状态

5、以下哪条不是促进扩散的特征  答案：D

A、不消耗能量    B、有结构特异性要求    C、由高浓度向低浓度转运

D、不需载体进行转运    E、有饱和状态

6、关于胃肠道吸收下列哪些叙述是错误的  答案：A

A、 当食物中含有较多脂肪，有时对溶解度特别小的药物能增加吸收量

B、 一些通过主动转运吸收的物质，饱腹服用吸收量增加

C、 一般情况下，弱碱性药物在胃中容易吸收

D、 当胃空速率增加时，多数药物吸收加快

E、 脂溶性，非离子型药物容易透国细胞膜

7、药物剂型对药物胃肠道吸收影响因素不包括  答案：E

A、药物在胃肠道中的稳定性    B、粒子大小    C、多晶型

D、解离常数    E、胃排空速率

8、影响药物胃肠道吸收的生理因素不包括   答案：D

A、胃肠液成分与性质    B、胃肠道蠕动    C、循环系统

D、药物在胃肠道中的稳定性    E、胃排空速率

wx486

不是太明白，最好把帖子中的内容变成你要求的样子，才好理解。

zhanglei1371

问题是这样的：比如原来选项：A、张 B、王 C、李 D、赵
答案选项是D，值为赵，按照设定的答案序列，要将答案变成B.于是程序自动将B和D的值互换，成为
A、张 B、赵 C、李 D、王
这样答案就实现了D→B，如果有100道这样的题，答案都在题干后，非常不规律，我现在要将答案统一设置为ABCD重复循环，使改卷变得很轻松。如果还不能领会含义，晚上我再具体上传结果示例。

wx486

zhanglei1371 发表于 2013-6-22 09:09
问题是这样的：比如原来选项：A、张 B、王 C、李 D、赵
答案选项是D，值为赵，按照设定的答案序列，要将答 ...

哈哈。理解了，不过考试的时候设计成这样的话，是不是让学生发现规律了不好呢？

zhanglei1371

可以八个一组的，或者七个循环一次。我这样写是为了便于解释问题。
其实我最初的设想是这样的：第一步实现在题库的四百道题中随机抽取四十道题，第二步实现将ABCDE五个选项的值随机排列，第三步实现按照设定的答案序列自动交换选项值。上面的问题即是第三个问题。

sylun

可试试如下测试代码：

1. Sub test()
   
2.     Dim strOrder As String
   
3.     Dim i As Byte
   
4.     Dim strAnswer As String
   
5.     Dim TempRange As Range
   
6.     Dim strTemp1 As String
   
7.     Dim strTemp2 As String
   
8.    
   
9.     strOrder = "ABCD"
   
10.     i = 1
    
11.     Application.ScreenUpdating = False
    
12.     With ActiveDocument.Content.Find
    
13.         .Text = "答案：[A-E]"
    
14.         .MatchWildcards = True
    
15.         Do While .Execute
    
16.             With .Parent
    
17.                 strAnswer = Right(.Text, 1)
    
18.                 '.Text = Empty
    
19.                 Set TempRange = .Duplicate
    
20.                 TempRange.Collapse wdCollapseEnd
    
21.                 With TempRange.Duplicate.Find
    
22.                     .Text = "[^9^13^32]" & strAnswer & "、[!^13][!^13^32]{2,}"
    
23.                     .MatchWildcards = True
    
24.                     If .Execute = True Then
    
25.                         With .Parent
    
26.                             If Mid(.Text, 2, 1) <> Mid(strOrder, i, 1) Then
    
27.                                 .Start = .Start + 3
    
28.                                 strTemp1 = .Text
    
29.                                 With TempRange.Duplicate.Find
    
30.                                     .Text = "[^9^13^32]" & Mid(strOrder, i, 1) & "、[!^13][!^13^32]{2,}"
    
31.                                     .MatchWildcards = True
    
32.                                     If .Execute = True Then
    
33.                                         With .Parent
    
34.                                             .Start = .Start + 3
    
35.                                             strTemp2 = .Text
    
36.                                             TempRange.HighlightColorIndex = wdYellow
    
37.                                             .Text = strTemp1
    
38.                                             .HighlightColorIndex = wdGreen
    
39.                                         End With
    
40.                                     End If
    
41.                                 End With
    
42.                                 .Text = strTemp2
    
43.                                 .HighlightColorIndex = wdYellow
    
44.                             Else
    
45.                                 .Start = .Start + 3
    
46.                                 .HighlightColorIndex = wdPink
    
47.                             End If
    
48.                         End With
    
49.                     End If
    
50.                 End With
    
51.                 If i = Len(strOrder) Then i = 1 Else i = i + 1
    
52.             End With
    
53.             .Parent.Collapse wdCollapseEnd
    
54.         Loop
    
55.     End With
    
56.     Application.ScreenUpdating = True
    
57. End Sub

复制代码