监考考场随机抽签期待大神现身！

thzythzy · 发表于 2019-6-8 21:09

本帖最后由 thzythzy 于 2019-6-9 20:53 编辑

监考要求每堂考试随机抽签，领导交代用Excel做一个抽签表，烦请大神指教。

6月9日更新
谢谢各位，本人水平有限，用各位提供的方案都未能解决我急需解决的问题。
已经请行家帮助做好了，在此一并感谢一天内回复本帖的各位热心网友，致谢。
本贴请不要再特意回复。感谢！！

qingc0221 · 发表于 2019-6-8 22:09

一个简单的方法：先把已抽出的排除掉，剩下的装入数组，然后从中随机抽出一个就行

yjh_27 · 发表于 2019-6-8 23:07

实用抽签小工具
http://club.excelhome.net/thread-1137843-1-1.html
(出处: ExcelHome技术论坛)

limit2019 · 发表于 2019-6-9 02:04

适合我这样的初学者练习，点击任意一个标颜色的单元格，可在同一行“抽签考场”列产生随机结果。

719404338 · 发表于 2019-6-9 07:11

试试看，是不是你想要的？

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row >= 3 And Target.Row <= 22 And (Target.Column = 1 Or Target.Column = 7) And Target.Count = 1 Then
If Cells(Target.Row, Target.Column + 1) <> "" Then
MsgBox "请不要重复抽取！"
Exit Sub
End If
Dim i, j, d
Set d = CreateObject("Scripting.Dictionary")
For i = 3 To 22
If Range("b" & i) <> "" Then d(Range("b" & i).Value) = ""
If Range("h" & i) <> "" Then d(Range("h" & i).Value) = ""
Next i
i = Target.Row
j = Target.Column
0: k = WorksheetFunction.RandBetween(1, 40)
If d.exists(k) Then
GoTo 0
Else
Cells(i, j + 1) = k
End If
End If
End Sub

复制代码

thzythzy · 发表于 2019-6-9 08:18

719404338 发表于 2019-6-9 07:11
试试看，是不是你想要的？

您好试了下，没能成功。或许是我技术有问题。

vvw123 · 发表于 2019-6-9 08:36

719404338 发表于 2019-6-9 07:11
试试看，是不是你想要的？

今天早上想学习自己能不能成功的，结果兄台提供了一个非常好的学习样本，感谢

vvw123 · 发表于 2019-6-9 09:01

719404338 发表于 2019-6-9 07:11
试试看，是不是你想要的？

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row >= 3 And Target.Row <= 22 And (Target.Column = 1 Or Target.Column = 7) And Target.Count = 1 Then
If Cells(Target.Row, Target.Column + 1) <> "" Then
MsgBox "请不要重复抽取！"
Exit Sub
End If
Dim i, j, d
Set d = CreateObject("Scripting.Dictionary")
For i = 3 To 22
If Range("b" & i) <> "" Then d(Range("b" & i).Value) = ""
If Range("h" & i) <> "" Then d(Range("h" & i).Value) = ""
Next i
i = Target.Row
j = Target.Column
0: k = WorksheetFunction.RandBetween(1, 40)
If d.exists(k) Then
GoTo 0
Else
Cells(i, j + 1) = k
End If
End If
End Sub
Sub Clear()
Range("B3:B22,H3:H22").ClearContents
End Sub

复制代码

个人觉得这个还是双击激发避免点错

thzythzy · 发表于 2019-6-9 09:02

yjh_27 发表于 2019-6-8 23:07
实用抽签小工具
http://club.excelhome.net/thread-1137843-1-1.html
(出处: ExcelHome技术论坛)

您好拜读了您的原贴，收益匪浅。请问如何修改生成的抽签考场号和原始考场号数字范围完全匹配，也就是原始考场40——60，抽签生成的也是40——60？

vvw123 · 发表于 2019-6-9 09:04

vvw123 发表于 2019-6-9 09:01
个人觉得这个还是双击激发避免点错

监考员抽签表.rar (16.06 KB, 下载次数: 96)

		自动登录	找回密码
密码			免费注册

[求助] 监考考场随机抽签期待大神现身！

评分

最新热点 /1

[求助] 监考考场随机抽签 期待大神现身！

评分

最新热点 /1

[求助] 监考考场随机抽签期待大神现身！