vba调用mysql随机出题软件_题库需要随机进行出题

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