成果展示

宏代码

默认取人员名单2-201行，需要增加减少自定义行数，修改第7行代码即可

Dim flag
Sub 开始()
c = Rnd
Dim rng As Range
Set dic = CreateObject("scripting.dictionary")
n = 0
For i = 2 To 201
If Application.WorksheetFunction.CountIf(Range("d4:h12"), _
Worksheets("人员名单列表").Cells(i, 1)) = 0 Then
n = n + 1
dic(n) = Worksheets("人员名单列表").Cells(i, 1)
End If
Next
flag = True
Do
DoEvents
If flag Then
Cells(4, 2) = dic(Int(Rnd * dic.Count + 1))
End If
Loop While flag
End Sub
Sub 停止()
flag = False
For i = 4 To 12
For j = 4 To 8
If Cells(i, j) = "" Then
Cells(i, j) = Cells(4, 2): GoTo 100
End If
Next
Next
100:
End Sub
Sub 清除()
For i = 2 To 100
c = Rnd
Next
Range("d4:h12").ClearContents
End Sub

下载链接

链接: 点击跳转下载