Function 随机试题() '产生随机数代码,40个随机数字从1~100中取
'1、声明变量
Dim dx As Integer '随机单选题数值
Dim dxjh As New Collection '随机单选题数值集合,不重复
Dim dxzsl As Integer '单选题库总数量
Dim dxsl As Integer '本次单选题数量
Dim ux As Integer '随机多选题数值
Dim uxjh As New Collection '随机多选题数值集合,不重复
Dim uxzsl As Integer '多选题库总数量
Dim uxsl As Integer '本次多选题数量
Dim pd As Integer '随机判断题数值
Dim pdjh As New Collection '随机判断题数值集合,不重复
Dim pdzsl As Integer '判断题库总数量
Dim pdsl As Integer '本次判断题数量
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim a As Integer '循环值
'2、初始赋值
Set ws1 = ThisWorkbook.Worksheets("题库")
Set ws2 = ThisWorkbook.Worksheets("考试结果")
Set ws3 = ThisWorkbook.Worksheets("系统参数")
dxzsl = 0
uxzsl = 0
pdzsl = 0
'3、计算单选、多选、判断题的总数量及本次选择数量
'(1)删除原来选择的题目
For a = 2 To ws2.UsedRange.Rows.Count
ws2.Cells(a, 3) = ""
ws2.Cells(a, 4) = ""
ws2.Cells(a, 5) = ""
ws2.Cells(a, 6) = ""
ws2.Cells(a, 7) = ""
Next
'(1)计算试题总量
For a = 2 To ws1.UsedRange.Rows.Count
If ws1.Cells(a, 8) = "单选题" Then
dxzsl = dxzsl + 1
End If
If ws1.Cells(a, 8) = "多选题" Then
uxzsl = uxzsl + 1
End If
If ws1.Cells(a, 8) = "判断题" Then
pdzsl = pdzsl + 1
End If
Next
dxsl = ws3.Cells(4, 2)
uxsl = ws3.Cells(8, 2)
pdsl = ws3.Cells(12, 2)
With ws3.Cells(4, 2).FormatConditions
.Delete
.Add Type:=xlExpression, Formula1:=dxsl > dxzsl
.Item(1).Interior.ColorIndex = 3
End With
With ws3.Cells(8, 2).FormatConditions
.Delete
.Add Type:=xlExpression, Formula1:=uxsl > uxzsl
.Item(1).Interior.ColorIndex = 3
End With
With ws3.Cells(12, 2).FormatConditions
.Delete
.Add Type:=xlExpression, Formula1:=pdsl > pdzsl
.Item(1).Interior.ColorIndex = 3
End With
If dxsl > dxzsl Then
dxsl = dxzsl: ws3.Cells(4, 2) = dxzsl: ws3.Cells(4, 2).Select
End If
If uxsl > uxzsl Then
uxsl = uxzsl: ws3.Cells(8, 2) = uxzsl: ws3.Cells(8, 2).Select
End If
If pdsl > pdzsl Then
pdsl = pdzsl: ws3.Cells(12, 2) = pdzsl: ws3.Cells(12, 2).Select
End If
'
'4、随机选择题目
On Error Resume Next '如果集合里出现重复值就会产生错误,故要用到错误处理
Randomize '初始化随机数生成器(用系统计时器(Timer 函数)的返回值作为新的随机数种子值)
Do
dx = Int(Rnd() * dxzsl) + 1
If dx > dxzsl Then
dx = dxzsl
End If
dxjh.Add dx, CStr(dx)
Loop Until dxjh.Count = dxsl '增加到集合里,一直到集合里的个数等于单选题数
For a = 1 To dxsl
ws2.Cells(a + 1, 3) = dxjh(a) + 1
Next
For Each dxx In dxjh
dxx.Remove
Next
Randomize '初始化随机数生成器(用系统计时器(Timer 函数)的返回值作为新的随机数种子值)
Do
ux = Int(Rnd() * uxzsl) + 1
If ux > uxzsl Then
ux = uxzsl
End If
uxjh.Add ux, CStr(ux)
Loop Until uxjh.Count = uxsl '增加到集合里,一直到集合里的个数等于多选题数
For a = 1 To uxsl
ws2.Cells(a + dxsl + 1, 3) = uxjh(a) + dxzsl + 1
Next
For Each uxx In uxjh
uxx.Remove
Next
Randomize '初始化随机数生成器(用系统计时器(Timer 函数)的返回值作为新的随机数种子值)
Do
pd = Int(Rnd() * pdzsl) + 1
If pd > pdzsl Then
pd = pdzsl
End If
pdjh.Add pd, CStr(pd)
Loop Until pdjh.Count = pdsl '增加到集合里,一直到集合里的个数等于判断题数
For a = 1 To pdsl
ws2.Cells(a + dxsl + uxsl + 1, 3) = pdjh(a) + dxzsl + uxzsl + 1
Next
For Each pdx In pdjh
pdx.Remove
Next
'5、试题标准答案、试题分值
For a = 2 To ws2.UsedRange.Rows.Count
ws2.Cells(a, 4) = ws1.Cells(ws2.Cells(a, 3), 9)
ws2.Cells(a, 5) = ""
If ws2.Cells(a, 2) = "单选题" Then
ws2.Cells(a, 6) = ws3.Cells(5, 2)
End If
If ws2.Cells(a, 2) = "多选题" Then
ws2.Cells(a, 6) = ws3.Cells(9, 2)
End If
If ws2.Cells(a, 2) = "判断题" Then
ws2.Cells(a, 6) = ws3.Cells(13, 2)
End If
ws2.Cells(a, 7) = ""
Next
'6、试题排序
ws2.Columns("C:D").Sort Key1:=ws2.Range("C1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlSortColumns, SortMethod:=xlPinYin, DataOption1:=xlSortNormal
'Err.Clear
'On Error GoTo 0 '清除错误处理,之后产生的错误还会捕捉到
End Function