求助：Excel能否随机匹配裁判员和选手？

上个附件到百度网盘再贴上链接地址，就是裁判不能是本校的是吧，这种问题可能会无解的。

表格已经传到百度网盘
链接: https://pan.baidu.com/s/122KvYBEsLjIVqZE4qoy_9Q 提取码: vh54 复制这段内容后打开百度网盘手机App，操作更方便哦

P老师不属于任何学校的吗？做附件要认真一点，你是在求助而不是在给别人出题考试。
如果有解的晚上再给你看看，我有点事情要出去。

翻扑克牌不香么？

'有点意思，这问题还具有一定的通用性
'同组2位选手及裁判都为不同学校，有解优先局部多次随机
Option Explicit
Sub 同组选手及裁判不同校()
　Dim a(2), i, j, p, m, n, cnt, d, t
　Set d = CreateObject("scripting.dictionary")
　a(0) = [a3].CurrentRegion.Offset(1).Resize(, 2).Value
　Call rnddata(a(0), 1, UBound(a(0)) - 1, 1, 2)
　Call bsort(a(0), 1, UBound(a(0)) - 1, 1, 2, 2)
　ReDim pos(1 To UBound(a(0)) - 1, 1 To 3)
　For i = 1 To UBound(a(0)) - 1
　　If a(0)(i, 2) <> a(0)(i + 1, 2) Then
　　　cnt = cnt + 1
　　　pos(cnt, 1) = p + 1: pos(cnt, 2) = i: pos(cnt, 3) = i - p
　　　p = i
　　End If
　Next
　Call bsort(pos, 1, cnt, 1, 3, 3)
　p = 0
　For i = 1 To cnt
　　If pos(i, 3) <> pos(i + 1, 3) Then
　　　Call rnddata(pos, p + 1, i, 1, 3)
　　　p = i
　　End If
　Next
　For i = 1 To cnt
　　d(a(0)(pos(i, 1), 2)) = i
　Next
　a(1) = [d3].CurrentRegion.Offset(1).Resize(, 2).Value
　For i = 1 To UBound(a(1)) - 2
　　For j = i + 1 To UBound(a(1)) - 1
　　　If d(a(1)(i, 2)) > d(a(1)(j, 2)) Then
　　　　t = a(1)(i, 1): a(1)(i, 1) = a(1)(j, 1): a(1)(j, 1) = t
　　　　t = a(1)(i, 2): a(1)(i, 2) = a(1)(j, 2): a(1)(j, 2) = t
　　　End If
　　Next
　Next
　a(2) = a(1)
　For i = 1 To pos(1, 3)
　　a(1)(i, 1) = a(2)(i + (UBound(a(2)) - 1) - pos(1, 3), 1)
　　a(1)(i, 2) = a(2)(i + (UBound(a(2)) - 1) - pos(1, 3), 2)
　Next
　For i = pos(1, 3) + 1 To UBound(a(1)) - 1
　　a(1)(i, 1) = a(2)(i - pos(1, 3), 1)
　　a(1)(i, 2) = a(2)(i - pos(1, 3), 2)
　Next
　ReDim b(1 To UBound(a(0)) - 1, 1 To 5) As String
　Do
　　For i = 1 To cnt
　　　If pos(i, 1) <= pos(i, 2) Then
　　　　m = m + 1
　　　　b(m, 2) = a(0)(pos(i, 1), 1): b(m, 3) = a(0)(pos(i, 1), 2)
　　　　pos(i, 1) = pos(i, 1) + 1
　　　　If m Mod 2 = 0 Then
　　　　　n = n + 1
　　　　　b(m - 1, 4) = a(1)(n, 1): b(m - 1, 5) = a(1)(n, 2)
　　　　　Exit For
　　　　End If
　　　End If
　　Next
　Loop Until m = UBound(a(0)) - 1
　Randomize
　For i = 1 To UBound(b) Step 2
　　n = (Int(Rnd * (UBound(b) / 2)) + 1) * 2 - 1
　　For j = 2 To UBound(b, 2)
　　　t = b(i, j): b(i, j) = b(n, j): b(n, j) = t
　　　t = b(i + 1, j): b(i + 1, j) = b(n + 1, j): b(n + 1, j) = t
　　Next
　　If Rnd < 0.5 Then
　　　For j = 2 To 3
　　　　t = b(i, j): b(i, j) = b(i + 1, j): b(i + 1, j) = t
　　　Next
　　End If
　　b(i, 1) = Format(i, "0座位"): b(i + 1, 1) = Format(i + 1, "0座位")
　Next
　If check(b) = False Then MsgBox "!": Exit Sub
　[h4].Resize(UBound(b), UBound(b, 2)) = b
End Sub
Function check(a) As Boolean
　Dim i
　For i = 1 To UBound(a) Step 2
　　If a(i, 3) = a(i, 5) Or a(i + 1, 3) = _
　　　a(i, 5) Or a(i, 3) = a(i + 1, 3) Then Exit Function
　Next
　check = True
End Function
Function bsort(a, first, last, left, right, key)
　Dim i, j, k, t
　For i = first To last - 1
　　For j = first To last + first - 1 - i
　　　If a(j, key) < a(j + 1, key) Then
　　　　For k = left To right
　　　　　t = a(j, k): a(j, k) = a(j + 1, k): a(j + 1, k) = t
　　　　Next
　　　End If
　　Next
　Next
End Function
Function rnddata(a, first, last, left, right)
　Dim i As Long, j As Long, n As Long, cnt As Long, t
　cnt = last - first + 1
　Randomize
　For i = first To last
　　n = Int(Rnd * cnt)
　　For j = left To right
　　　t = a(i, j): a(i, j) = a(first + n, j): a(first + n, j) = t
　　Next
　Next
End Function

“现在有32位选手，16位裁判。要求是2名裁判监考4名选手，不能出现来自同一单位的情况。请问有没有办法解决”
私信收到，我对所有私信都不会作回复的。上个附件到百度网盘再贴上链接地址，当然学校或名字可以稍作替换，我要大概看一下是否有解。方法差不多的，可以给你作一下修改。
有个问题4+2为一组，他们6个人中任何2人都不能为同一学校是这个意思的吧。

可能我没说清楚，应该是4名选手对应2名裁判。只要裁判和选手不出现同一单位即可。一单位

看了一下附件有34名学生18为评委，其中多出的2位学生也需2位评委的吧。如果多出1、3位学生都是2位评委？那就是说可能会出现1位学生配2位评委这情况。
“只要裁判和选手不出现同一单位即可”，最简单的方法就是按学校有序，评委的也一样，然后错位处理一下就可以了，就是结果比较极端但它符合条件。
条件要尽量明确，另外感觉这问题并不是你自己的，只是一个中转站而已。

先用函数公式做了个学生排位
B1="111111111111111111111111111111 "
B2=RANDBETWEEN(1,32-ROW())
c2==MATCH(1,MID(B1,ROW($1:$30),1)-MID(B2,ROW($1:$30),1),)
随机做成抽签号（辅助表）

在主表中
I4=INDEX(A$4:A$33,Sheet1!D2)
J4=VLOOKUP(I4,A$4:B$33,2,)

后面的明天再来想

晕，又给吃掉了
链接:https://pan.baidu.com/s/1yC694uIPS3zsvv4kP70J4g 提取码:2h8v 复制这段内容后打开百度网盘手机App，操作更方便哦
文件名：选手与裁判抽签表-jincai688.xlsm、
-----------