学校有个技能鉴定想弄成随机抽题的题库，不会弄，特来求助大神们

wjadn

1．（  D  ）不属于我国铁路采用的到发线有效长度。

    （A）1 250 m    （B）1 050 m    （C）850 m    （D）600 m

    2．（   C ）不属于线路标志。

    （A）公里标    （B）曲线标    （C）警冲标    （D）管界标

    3．路基侧沟的深度和宽度均不应小于（  B  ）。

    （A）0.3 m     （B）0.4 m      （C）0.6 m      （D）0.8 m

    4．当350 m＞曲线半径≥300 m时，其轨距加宽值为（  B  ）。

    （A）0mm    （B）5mm    （C）10mm    （D）15mm

    5．铁路轨距变化应和缓平顺，允许速度大于120 km/h线路的轨距变化率不得大于    （  A  ）。

    （A）1‰    （B）2‰    （C）3‰    （D）4‰

    6．直线线路上轨向以10 m弦在轨头内侧顶面下（ C   ）处量取最大矢度。

    （A）10mm    （B）15mm    （C）16mm    （D）20mm

    7．轨底坡设置是否正确，可以从钢轨顶面上的光带位置判定。下列关于光带和轨底坡的说法中正确的是（  C  ）。

    （A）如果光带偏向内侧，说明轨底坡合适

    （B）如果光带偏向外侧，则说明轨底坡不足

    （C）如果光带居中，说明轨底坡合适

    （D）如果光带偏向内侧，说明轨底坡过大

    8．（  C  ）不属于钢轨主要参数。

    （A）钢轨的头部顶面宽    （B）钢轨的轨腰厚

    （C）钢轨的长度    （D）钢轨的轨底宽

duquancai

你的需求不明确，不好办？比如，随机抽取：重多少道题随机抽取多少道？是全部随机抽取吗？看了你的具体文档，只是针对纯文本吗？（还是  文档中有表格、图形、图片、域、还有可能有插入的外部公式吗？），等等未知数太多？

duquancai

你的文档，用4个英文空格来“退2格”定位对齐的做法，尤其是段首及段尾原则上是不允许出现空格的，是很不好的一个糟糕的坏习惯，当然这也是绝大多数人的坏毛病！！！对于word中文排版(英文必然会有空格，因为英文单词与单词之间就是一个英文空格)除非迫不得已，文档中尽最大力量不要出现空格，也请尽最大力量不要出现空段落！！！

wjadn

duquancai 发表于 2016-11-23 15:13
你的需求不明确，不好办？比如，随机抽取：重多少道题随机抽取多少道？是全部随机抽取吗？看了你的具体文档 ...

只是针对纯文档的，选择题随机抽取80道判断题随机抽取20道

wjadn

duquancai 发表于 2016-11-23 15:22
你的文档，用4个英文空格来“退2格”定位对齐的做法，尤其是段首及段尾原则上是不允许出现空格的，是很不好 ...

好的，知道了，因为那样子方便，所以这个坏习惯一直就存在，以后就会改正过来的，谢谢指出

duquancai

wjadn 发表于 2016-11-23 15:48
只是针对纯文档的，选择题随机抽取80道判断题随机抽取20道

附件，打开Word文档，点击随机抽取试题按钮》》》》》》》

1. Private Sub 随机抽取试题_Click()
   
2.    Dim mt, mh, Arng As Range, d1 As Object, i%, j%, n%, m%, d2 As Object
   
3.    Dim dd As New 随机抽取, str$, str选择题$, str判断题$, a, b, s1$, s2$
   
4.    Set d1 = CreateObject("Scripting.Dictionary")
   
5.    Set d2 = CreateObject("Scripting.Dictionary")
   
6.    Set Arng = ThisDocument.Content
   
7.    With CreateObject("vbscript.regexp")
   
8.       .Global = True: .MultiLine = True
   
9.       .Pattern = "^\s+|\s+$" '清空段首段尾及空段落
   
10.       str = .Replace(Arng.Text, "")
    
11.       .Pattern = "^(（[一二]）(?:(?!(?:^（一）选择题|^（二）判断题)).)+)"
    
12.       str选择题 = .Execute(str)(0): str判断题 = .Execute(str)(1)
    
13.       .Pattern = "^\d+(?:(?!^\d+[^\r]+\r).)+"
    
14.       For Each mt In .Execute(str选择题)
    
15.          i = i + 1: d1(i) = mt
    
16.       Next
    
17.       For Each mh In .Execute(str判断题)
    
18.          j = j + 1: d2(j) = mh
    
19.       Next
    
20.    End With
    
21.    k1 = d1.keys: k2 = d2.keys
    
22.    a = dd.Rndcq(k1, 80): b = dd.Rndcq(k2, 20) '随机选择题80道，道判断题20
    
23.    For n = LBound(a) To UBound(a)
    
24.       s1 = s1 & d1(a(n))
    
25.    Next
    
26.    For m = LBound(b) To UBound(b)
    
27.       s2 = s2 & d2(b(m))
    
28.    Next
    
29.    Documents.Add
    
30.    With ActiveDocument.Content
    
31.       .Text = "（一）选择题80道" & vbCr
    
32.       .InsertAfter s1
    
33.       .InsertAfter "（二）判断题20道" & vbCr
    
34.       .InsertAfter s2
    
35.    End With
    
36. End Sub

复制代码

wjadn

duquancai 发表于 2016-11-23 17:31
附件，打开Word文档，点击随机抽取试题按钮》》》》》》》

非常感谢！

duquancai

wjadn 发表于 2016-11-23 18:17
非常感谢！

附件，点击按钮》》》》》

1. Private Sub 随机抽取试题_Click()
   
2.    Dim mt, mh, Arng As Range, d1 As Object, i%, j%, n%, m%, d2 As Object
   
3.    Dim dd As New 随机抽取, str$, str选择题$, str判断题$, a, b, s1$, s2$
   
4.    Set d1 = CreateObject("Scripting.Dictionary")
   
5.    Set d2 = CreateObject("Scripting.Dictionary")
   
6.    Set Arng = ThisDocument.Content
   
7.    With CreateObject("vbscript.regexp")
   
8.       .Global = True: .MultiLine = True
   
9.       .Pattern = "^\s+|\s+$" '清空段首段尾及空段落
   
10.       str = .Replace(Arng.Text, "")
    
11.       .Pattern = "^(（[一二]）(?:(?!(?:^（一）选择题|^（二）判断题)).)+)"
    
12.       str选择题 = .Execute(str)(0): str判断题 = .Execute(str)(1)
    
13.       .Pattern = "^\d+(?:(?!^\d+[^\r]+\r).)+"
    
14.       For Each mt In .Execute(str选择题)
    
15.          i = i + 1: d1(i) = mt
    
16.       Next
    
17.       For Each mh In .Execute(str判断题)
    
18.          j = j + 1: d2(j) = mh
    
19.       Next
    
20.       k1 = d1.keys: k2 = d2.keys
    
21.       r1 = InputBox("输入抽取选择题数量", , 80): r2 = InputBox("输入抽取判断题数量", , 20)
    
22.       If Val(r1) > d1.Count Or Val(r1) = 0 Then MsgBox "抽取量不能为0或大于样本容量！": Exit Sub
    
23.       If Val(r2) > d2.Count Or Val(r2) = 0 Then MsgBox "抽取量不能为0或大于样本容量！": Exit Sub
    
24.       a = dd.Rndcq(k1, Val(r1)): b = dd.Rndcq(k2, Val(r2))
    
25.       .Pattern = "^\d+(?=\D)" '重新顺序编号
    
26.       For n = LBound(a) To UBound(a)
    
27.          s1 = s1 & .Replace(d1(a(n)), n)
    
28.       Next
    
29.       For m = LBound(b) To UBound(b)
    
30.          s2 = s2 & .Replace(d2(b(m)), m)
    
31.       Next
    
32.    End With
    
33.    Documents.Add
    
34.    With ActiveDocument.Content
    
35.       .Text = "（一）选择题" & r1 & "道" & vbCr
    
36.       .InsertAfter s1
    
37.       .InsertAfter "（二）判断题" & r2 & "道" & vbCr
    
38.       .InsertAfter s2
    
39.    End With
    
40. End Sub

复制代码

tangqingfu

duquancai 发表于 2016-11-24 00:51
附件，点击按钮》》》》》

谢谢分享，收藏学习！

gzr272914

您好，如果是有四种题型，需要修改哪些地方呢？