'插入2个按钮再分别连接一下,,,
Option Explicit
Dim flag As Boolean
Sub 运行()
Dim arr, pos, i, j, m, n, t
With Sheets("监考人员")
arr = .Range("b4:c" & .Cells(Rows.Count, "b").End(xlUp).Row)
End With
ReDim brr(1 To 30, 1 To 3)
pos = Split("b i"): flag = True
Do
For i = 1 To UBound(arr, 1)
n = Int(Rnd * (UBound(arr, 1) - i + 1)) + i
t = arr(i, 1): arr(i, 1) = arr(n, 1): arr(n, 1) = t
t = arr(i, 2): arr(i, 2) = arr(n, 2): arr(n, 2) = t
Next
m = 0
For i = 0 To UBound(pos)
For j = 1 To UBound(brr, 1)
m = m + 1: brr(j, 1) = m
brr(j, 2) = arr(m, 1): brr(j, 3) = arr(m, 2)
Next
Sheets("监考随机安排").Range(pos(i) & 6).Resize(UBound(brr, 1), 3) = brr
Next
t = Timer
Do
DoEvents
If Not flag Then Exit Sub
Loop Until Timer - t >= 0.5
Loop
End Sub
Sub 终止()
flag = False
End Sub |