【无标题】EXCEL实现刷题

实现的思路：
导入题库word文件导入到excel–>绑定随机事件选定考题。
word题库导入Excel表的代码如下：

整理题库结构（添加题号，分离答案）
Public Sub numAdd()
Dim rng As Range, RNG1 As Range
With Sheet1
.[b1] = “题号”
.[c1] = “答案”
On Error Resume Next
For Each rng In .Range(“a2:a” & .Cells(Rows.Count, 1).End(xlUp).Row)
'rng = Replace(rng, chr(13), “”)
If qFind(rng) <> “” Then 'And qFind(rng) Like “[a-dA-D√?×Xx]” Then
counter = counter + 1
If qFind(rng) Like “[?√Vv]” Then
rng.Offset(0, 2) = “Y”
ElseIf qFind(rng) Like “[×Xx]” Then
rng.Offset(0, 2) = “N”
ElseIf Asc(qFind(rng)) = 63 Then
rng.Offset(0, 2) = “Y”
Else
rng.Offset(0, 2) = qFind(rng)
End If
rng = counter & ". " & Replace(rng.Value, qFind(rng), “”)
rng.Offset(0, 1) = counter
If rng.Row < .Columns(1).Find(“判断题：”).Row Then
rws = rng.End(xlDown).Row - rng.Row
’ Debug.Print rng & “|” & rws
If rws = 4 Then
For Each RNG1 In .Range(.Cells(rng.Row + 1, 1), .Cells(rng.End(xlDown).Row, 1))
ct = ct + 1
Select Case ct
Case Is = 1
RNG1 = "A. " & RNG1.Value
Case Is = 2
RNG1 = "B. " & RNG1.Value
Case Is = 3
RNG1 = "C. " & RNG1.Value
Case Is = 4
RNG1 = "D. " & RNG1.Value

                End Select
            Next
        ElseIf rws = 5 Then
            For Each RNG1 In .Range(.Cells(rng.Row + 1, 1), .Cells(rng.End(xlDown).Row, 1))
                ct = ct + 1
                Select Case ct
                    Case Is = 1
                        RNG1 = "A. " & RNG1.Value
                    Case Is = 2
                        RNG1 = "B. " & RNG1.Value
                    Case Is = 3
                        RNG1 = "C. " & RNG1.Value
                    Case Is = 4
                        RNG1 = "D. " & RNG1.Value
                    Case Is = 5
                        RNG1 = "E. " & RNG1.Value
                End Select
            Next
    
        ElseIf rws = 9 Then
            For Each RNG1 In .Range(.Cells(rng.Row + 1, 1), .Cells(rng.End(xlDown).Row, 1))
                ct = ct + 1
                Select Case ct
                    Case Is = 1
                        RNG1 = "A. " & RNG1.Value
                    Case Is = 2
                        RNG1 = "B. " & RNG1.Value
                    Case Is = 3
                        RNG1 = "C. " & RNG1.Value
                    Case Is = 4
                        RNG1 = "D. " & RNG1.Value
                    Case Is = 5
                    RNG1 = "E. " & RNG1.Value
                    Case Is = 6
                        RNG1 = "F. " & RNG1.Value
                    Case Is = 7
                        RNG1 = "G. " & RNG1.Value
                    Case Is = 8
                        RNG1 = "H. " & RNG1.Value
                    Case Is = 9
                        RNG1 = "I. " & RNG1.Value
                End Select
            Next
        End If
    End If
End If
ct = 0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

Next
Sheet2.TextBox1.Text = counter
End With
End Sub
设计操作界面

绑定点击操作事件
Private Sub CommandButton1_Click()
On Error Resume Next
Dim qnum As Integer, no As Integer

If Sheet2.OptionButton1.Value Then
selectQNum = Sheet1.Columns(1).Find(“判断题：”).Offset(0, 1).End(xlUp)
no = WorksheetFunction.RandBetween(1, selectQNum)
no = uniqueGen(no)
Call qSelect(no)
Sheet2.TextBox2.Text = no
[e1] = “已选题号”
Cells(Rows.Count, “e”).End(xlUp).Offset(1, 0) = no
Else
stNum = Sheet1.Columns(1).Find(“判断题：”).Offset(0, 1).End(xlDown)
endNum = Sheet1.Cells(Rows.Count, 2).End(xlUp)
no = WorksheetFunction.RandBetween(stNum, endNum)
no = uniqueGen(no)
Call qSelect(no)
Sheet2.TextBox2.Text = no
[e1] = “已选题号”
Cells(Rows.Count, “e”).End(xlUp).Offset(1, 0) = no
End If
End Sub

创建非重复题目选择函数
Public Function uniqueGen(no)
On Error Resume Next
selectQNum = Sheet1.Columns(1).Find(“判断题：”).Offset(0, 1).End(xlUp)
For i = 1 To selectQNum
If Sheet2.OptionButton1.Value = True Then
no = WorksheetFunction.RandBetween(1, selectQNum)
If Sheet2.Columns(“e”).Find(no).Row = “” Then
uniqueGen = no
Exit For
End If
Else
stNum = Sheet1.Columns(1).Find(“判断题：”).Offset(0, 1).End(xlDown)
endNum = Sheet1.Cells(Rows.Count, 2).End(xlUp)
no = WorksheetFunction.RandBetween(stNum, endNum)
If Sheet2.Columns(“e”).Find(no).Row = “” Then
uniqueGen = no
Exit For
End If
End If
Next
End Function
给“查看答案”添加执行程序，代码如下：