|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 一把小刀闯天下 于 2019-10-9 17:57 编辑
'看了一下大概差不多,自己好好测试一下,,,
Option Explicit
Sub test()
Dim arr, i, j, t, n
arr = Sheets("考官库").[a1].CurrentRegion.Offset(1)
ReDim dic(1 To UBound(arr, 1) - 1)
Randomize
For i = 1 To UBound(arr, 1) - 1
Set dic(i) = CreateObject("scripting.dictionary")
For j = 3 To UBound(arr, 2)
dic(i)(arr(i, j)) = i
Next
For j = 4 To UBound(arr, 2)
n = Int(Rnd * (UBound(arr, 2) + 1 - j)) + j
t = arr(i, j): arr(i, j) = arr(i, n): arr(i, n) = t
Next
Next
For j = 3 To UBound(arr, 2)
For i = 1 To UBound(arr, 1) - 2
Do
n = Int(Rnd * (UBound(arr, 1) - i)) + i
If Not dic(i).exists(arr(n, j)) Then
t = arr(i, j): arr(i, j) = arr(n, j): arr(n, j) = t
Exit Do
End If
Loop
Next
If dic(i).exists(arr(i, j)) Then j = j - 1
Next
Sheets("抽签结果").[b17].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub
|
评分
-
3
查看全部评分
-
|