用电子 表格实现两组监考教师考场抽签(急）

80231314

抽签.rar (2 KB, 下载次数: 195)

2014-12-25 13:45 上传

点击文件名下载附件

实现监考教师一点开始就开始滚动，然后点停止，实现随机组合

qy1219no2

滚动的数据从哪儿来？

grf1973

把所有等抽的老师放在G列。。。。。。。。。。。。

1. Private Sub CommandButton1_Click()
   
2.     With CommandButton1
   
3.         .Caption = IIf(.Caption = "开始", "停止", "开始")
   
4.         For i = 1 To 1000000
   
5.             DoEvents
   
6.             If .Caption = "开始" Then Exit For
   
7.             Call tt
   
8.         Next
   
9.         .Caption = "开始"
   
10.     End With
    
11. End Sub
    
12. Sub tt()    '在[b2:c9]随机产生监考老师（不重复）
    
13.     arr = Range("g2:g" & [g65536].End(3).Row)   '所有监考老师
    
14.     Dim brr(1 To 8, 1 To 2)
    
15.     p = UBound(arr)
    
16.     For i = 1 To 8
    
17.         For j = 1 To 2
    
18.             x = Int(Rnd * p + 1)
    
19.             brr(i, j) = arr(x, 1)
    
20.             arr(x, 1) = arr(p, 1)
    
21.             p = p - 1
    
22.             If p = 0 Then GoTo aa
    
23.         Next
    
24.     Next
    
25. aa:
    
26.     [b2:c9] = brr
    
27. End Sub
    

复制代码

grf1973

请看附件。

qy1219no2

将全部被抽签的人员姓名填到“教师表”表中（不得修改格式和工作表名）
打开此文件时，请“启用宏”，否则，按钮无效。

qy1219no2

5楼的附件又更新了一下，请重新下载

80231314

grf1973 发表于 2014-12-25 14:55
请看附件。

能不能加你QQ，教我一下

qy1219no2

1. Private Sub CommandButton21_Click()
   
2.     Dim arr As New Collection
   
3.     nR = [a65536].End(xlUp).Row
   
4.     nR1 = Sheets("教师表").[a65536].End(xlUp).Row
   
5.     If nR < 2 Or nR1 < 2 Or nR * 2 - 2 > nR1 - 1 Then Exit Sub
   
6.     For i = 2 To nR1
   
7.         arr.Add Sheets("教师表").Cells(i, 2)
   
8.     Next
   
9.     [b2].Resize(nR - 1, 2).ClearContents
   
10.     For i = 2 To nR
    
11.         For j = 2 To 3
    
12.             For k = 1 To arr.Count '如果需要快速出结果，可将此句及后三句删除
    
13.                 n = Int(Rnd() * arr.Count) + 1
    
14.                 Cells(i, j) = arr(n)
    
15.                 For p = 1 To 4 * 10 ^ 6: Next
    
16.             Next
    
17.             Randomize Now
    
18.             n = Int(Rnd() * arr.Count) + 1
    
19.             Cells(i, j) = arr(n)
    
20.             arr.Remove n
    
21.         Next
    
22.     Next
    
23. End Sub

复制代码

80231314

qy1219no2 发表于 2014-12-25 15:26

能不能加我QQ教我一下1076908047

qy1219no2

80231314 发表于 2014-12-25 15:53
能不能加我QQ教我一下1076908047

这还用教吗？
直接将教师表完善了（A：B两列都必须填内容，对应的）
再将Sheet1的考场设置好（A列），然后，点“随机安排”按钮，就等着结果出来就可以了。
这难道还有不明白的？？