如何按照预定的答案为试题排序？

zhanglei1371 · 发表于 2017-1-5 21:39

本帖最后由 zhanglei1371 于 2017-1-6 07:28 编辑

1．我想实现自动按照设定的答案序列来设定题目选项，如下，原来的答案不规则，我想统一变成ABCDE的答案顺序，同时要求选项也自动做出调整，该怎么做？

如第6题用代码修改后成为：C
则AC选项也进行交换

2．如果多选题想变成AB、ABC、ABCD的答案形式，选项也自动变，该怎么做？

6．下列哪项不是简单扩散的特点(A)
A．无部位特异性 B．从高浓度到低浓度 C．不需载体
D．需要耗能 E．无竞争性抑制
7．新药III期临床实验需要的人数通常不少于(D)
A．20 B．100 C．200 D．250 E．300
8．下列不属于药物II相反应类型的有(E)
A．乙酰化 B．氧化 C．甲基化
D．硫酸结合 E．葡萄糖醛酸结合
9．下列哪个药物常用作滴鼻剂用于充血性鼻塞(C)
A．异丙肾上腺素 B．间羟胺 C．羟甲唑林
D．阿托品 E．毛果芸香碱
如

16．可能引发系统性红斑狼疮的降压药物为(CE)
A．硝酸甘油 B．普萘洛尔 C．肼屈嗪
D．卡维地洛 E．硝苯地平
17．强心苷类药物最严重的不良反应为(BCE)
A．黄视绿视 B．胃肠道不良反应 C．心律失常
D．耳鸣 E．骨髓抑制
18．金鸡纳反应为下列哪个药物的不良反应(ACDE)
A．利多卡因 B．普鲁卡因胺 C．胺碘酮
D．普罗帕酮 E．奎尼丁

duquancai · 发表于 2017-1-6 01:43

Sub shishi()
Dim mt, mh, mk, oRng As Range, rg As Range, n&, m&, str$, d, rng As Range
Set d = CreateObject("Scripting.Dictionary")
y = 4
With CreateObject("vbscript.regexp")
.Global = True: .IgnoreCase = False: .MultiLine = True
.Pattern = "^\d+．[^\r]+$([A-E])$\r(?:(?!^\d+．[^\r]+$(?:[A-E])$\r).)+"
For Each mt In .Execute(ActiveDocument.Content)
y = y + 1
m = mt.FirstIndex: n = mt.Length
Set oRng = ActiveDocument.Range(m, m + n)
str = mt.submatches(0)
.Pattern = "([A-E]．)((?:(?![A-E]．).)+)"
For Each mh In .Execute(oRng.Text)
m = mh.FirstIndex: n = mh.Length
Set rg = ActiveDocument.Range(oRng.Start + m, oRng.Start + m + n)
Set d(Left(rg.Text, 1)) = rg
Next
t = d.items
Select Case y Mod 5
Case 0
If str <> "A" Then
.Pattern = "$\s*[A-E]\s*$"
For Each mk In .Execute(oRng.Text)
m = mk.FirstIndex: n = mk.Length
Set rng = ActiveDocument.Range(oRng.Start + m, oRng.Start + m + n)
With rng
.MoveStart 1, 1: .MoveEnd 1, -1: .Text = "A"
End With
Next
With d(str)
.MoveStart 1, 2: .MoveEnd 1, -1: s1 = .Text
End With
With t(0)
.MoveStart 1, 2: .MoveEnd 1, -1: s2 = .Text
.Text = s1
End With
d(str).Text = s2
End If
Case 1
If str <> "B" Then
.Pattern = "$\s*[A-E]\s*$"
For Each mk In .Execute(oRng.Text)
m = mk.FirstIndex: n = mk.Length
Set rng = ActiveDocument.Range(oRng.Start + m, oRng.Start + m + n)
With rng
.MoveStart 1, 1: .MoveEnd 1, -1: .Text = "B"
End With
Next
With d(str)
.MoveStart 1, 2: .MoveEnd 1, -1: s1 = .Text
End With
With t(1)
.MoveStart 1, 2: .MoveEnd 1, -1: s2 = .Text
.Text = s1
End With
d(str).Text = s2
End If
Case 2
If str <> "C" Then
.Pattern = "$\s*[A-E]\s*$"
For Each mk In .Execute(oRng.Text)
m = mk.FirstIndex: n = mk.Length
Set rng = ActiveDocument.Range(oRng.Start + m, oRng.Start + m + n)
With rng
.MoveStart 1, 1: .MoveEnd 1, -1: .Text = "C"
End With
Next
With d(str)
.MoveStart 1, 2: .MoveEnd 1, -1: s1 = .Text
End With
With t(2)
.MoveStart 1, 2: .MoveEnd 1, -1: s2 = .Text
.Text = s1
End With
d(str).Text = s2
End If
Case 3
If str <> "D" Then
.Pattern = "$\s*[A-E]\s*$"
For Each mk In .Execute(oRng.Text)
m = mk.FirstIndex: n = mk.Length
Set rng = ActiveDocument.Range(oRng.Start + m, oRng.Start + m + n)
With rng
.MoveStart 1, 1: .MoveEnd 1, -1: .Text = "D"
End With
Next
With d(str)
.MoveStart 1, 2: .MoveEnd 1, -1: s1 = .Text
End With
With t(3)
.MoveStart 1, 2: .MoveEnd 1, -1: s2 = .Text
.Text = s1
End With
d(str).Text = s2
End If
Case 4
If str <> "E" Then
.Pattern = "$\s*[A-E]\s*$"
For Each mk In .Execute(oRng.Text)
m = mk.FirstIndex: n = mk.Length
Set rng = ActiveDocument.Range(oRng.Start + m, oRng.Start + m + n)
With rng
.MoveStart 1, 1: .MoveEnd 1, -1: .Text = "E"
End With
Next
With d(str)
.MoveStart 1, 2: .MoveEnd 1, -1: s1 = .Text
End With
With t(4)
.MoveStart 1, 2: .MoveEnd 1, -1: s2 = .Text
.Text = s1
End With
d(str).Text = s2
End If
End Select
d.RemoveAll
Next
End With
End Sub

复制代码

weiyingde · 发表于 2020-2-7 07:15

duquancai 发表于 2017-1-6 01:43

高人，学习了，受教了。赞一个。

		自动登录	找回密码
密码			免费注册

[已解决] 如何按照预定的答案为试题排序？

评分