求助：各位大侠，请帮忙监考员随机分组，谢谢！

MHanys

~~~~~~~~~~~~~

lishimin

MHanys 发表于 2024-9-4 17:20
~~~~~~~~~~~~~

感谢楼主，谢谢楼主大侠的辛苦付出！

wengjl

从4楼代码的后半段学到一个新的思路，谢谢 chxw68

chxw68

wengjl 发表于 2024-9-5 09:01
从4楼代码的后半段学到一个新的思路，谢谢 chxw68

对于这种问题，没有更好的办法，先随机分配，再对冲突项目微调。

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, br, xNum&, i&, j&, m&, n&, k&, vTemp, isFlag As Boolean, t#
   
    Application.ScreenUpdating = False
    t = Timer
   
    Randomize
    ar = [L4].CurrentRegion.Value
    m = UBound(ar)
    For i = 2 To m - 1
        xNum = Int((m - i + 1) * Rnd() + i)
        For j = 1 To 2
            vTemp = ar(xNum, j): ar(xNum, j) = ar(i, j): ar(i, j) = vTemp
        Next
    Next
    For i = 2 To m
        xNum = Int((m - i + 1) * Rnd() + i)
        For j = 3 To 4
            vTemp = ar(xNum, j): ar(xNum, j) = ar(i, j): ar(i, j) = vTemp
        Next
        If ar(i, 2) = ar(i, 4) Then n = n + 1 Else n = n + 2
    Next
   
    k = (UBound(ar) - 1) * 2
    Do Until k = n
        For i = 2 To UBound(ar)
            If ar(i, 2) = ar(i, 4) Then
                xNum = Int((m - 1) * Rnd() + 2)
                If xNum <> i And ar(xNum, 2) <> ar(i, 2) Then
                    isFlag = ar(xNum, 2) = ar(xNum, 4)
                    For j = 1 To 2
                        vTemp = ar(xNum, j): ar(xNum, j) = ar(i, j): ar(i, j) = vTemp
                    Next
                    n = n + 1
                    If isFlag Then
                        n = n + 1
                    Else
                        If ar(xNum, 2) = ar(xNum, 4) Then n = n - 1
                    End If
                    If n = k Then Exit For
                End If
            End If
        Next i
    Loop
      
    br = [A1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        br(i, 2) = ar(i, 1): br(i, 3) = ar(i, 3)
    Next i
    [A1].CurrentRegion.Value = br
            
    Application.ScreenUpdating = True
    MsgBox "执行完毕!_用时:  " & Format(Timer - t, "0.00") & "  秒", 64
End Sub

gwjkkkkk

,.............

lishimin

gwjkkkkk 发表于 2024-9-5 21:40
Option Explicit
Sub test()
    Dim ar, br, xNum&, i&, j&, m&, n&, k&, vTemp, isFlag As Boolean,  ...

感谢楼主的辛苦付出！

lishimin

gwjkkkkk 发表于 2024-9-5 21:40
,.............

感谢楼主的辛苦付出！