一个奇葩的监考安排

amzxfgh9632

longwin 发表于 2024-4-30 13:38
我也试一下，请楼主测试一下怎么样。
科目多了需要增加重算次数。

这样随机安排女+男，男+女，女+女更加合理了，但把考场设成30，基本没有正确的结果

yjh_27

参见附件。

jx928867128

yjh_27 发表于 2024-5-1 11:06
参见附件。

点赞一下，是位懂教务工作的高手，老师好，我在工作中也有一问题一直没解决，不知您方便帮我看看好吗https://club.excelhome.net/threa ... tml?_dsign=96a06c86

amzxfgh9632

yjh_27 发表于 2024-5-1 11:06
参见附件。

测试了一下，第4条还是有同一个教师进同一个考场的，谢谢帮助！！！！！！

yjh_27

amzxfgh9632 发表于 2024-5-1 13:34
测试了一下，第4条还是有同一个教师进同一个考场的，谢谢帮助！！！！！！

重新下载测试

djk1020

男女搭配基本能得到完全解，但混搭时若考试科目较多基本上难得到完全解
女+男：


男+女：

混搭：


奇葩监考安排.rar (28.37 KB, 下载次数: 4)

2024-5-1 19:30 上传

点击文件名下载附件

amzxfgh9632

djk1020 发表于 2024-5-1 19:30
男女搭配基本能得到完全解，但混搭时若考试科目较多基本上难得到完全解
女+男：

谢谢老师，目前测试可以支持12科，我有小想法，如果预先先设定主考教师，这样搭配起来不知道如何，谢谢老师的帮助。

守候_CJ

Excel VBA：用数组、字典、随机数实现监考安排示例

参考代码：

Sub 自动组合()
    Dim arr

    Dim i As Long
    Dim j As Long

    Dim dAll As Object
    Dim key
    Dim key1
    Dim keySwap

    Dim idxRnd As Long

    Dim dTemp As Object

    Dim brr '监考安排数据写入区域

    Dim crr
    Dim drr

    arr = ThisWorkbook.Worksheets("监考名单").UsedRange.Value

    Set dAll = CreateObject("Scripting.Dictionary")
    Set dTemp = CreateObject("Scripting.Dictionary")

    '遍历所有女教师，进行非重复两两组合，存入字典dAll
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        If arr(i, 2) <> "" And arr(i, 3) = "女" Then
            For j = LBound(arr, 1) + 1 To UBound(arr, 1)
                If arr(j, 2) <> "" And arr(i, 2) <> arr(j, 2) Then
                    key = arr(i, 2) & "_" & arr(j, 2)
                    keySwap = arr(j, 2) & "_" & arr(i, 2)

                    If Not (dAll.Exists(key) Or dAll.Exists(keySwap)) Then
                        dAll(key) = True
                    End If
                End If
            Next j
        End If
    Next i

    '遍历每个考场的每门学科，随机非重复从dAll中抽取4个组合
    brr = ThisWorkbook.Worksheets("监考安排").Range("A1:I27").Value

    For i = 3 To 27
        dTemp.RemoveAll

        For Each key In dAll.keys()
            dTemp(key) = True
        Next key

        For j = 1 To 4
            idxRnd = WorksheetFunction.RandBetween(0, dTemp.Count - 1)

            key = dTemp.keys()(idxRnd)

            crr = Split(key, "_")

            Select Case WorksheetFunction.RandBetween(0, 1)
                Case 0
                    brr(i, j * 2) = crr(0)
                    brr(i, j * 2 + 1) = crr(1)
                Case 1
                    brr(i, j * 2) = crr(1)
                    brr(i, j * 2 + 1) = crr(0)
            End Select

            dAll.Remove key '删除已经组合过的情况
            dTemp.Remove key

            '每场考试组合完成，删除两名教官相关的组合
            For Each key1 In dTemp.keys()
                drr = Split(key1, "_")

                If drr(0) = crr(0) Or drr(0) = crr(1) Or drr(1) = crr(0) Or drr(1) = crr(1) Then
                    dTemp.Remove key1
                End If
            Next key1
        Next j
    Next i

    '结果写入
    ThisWorkbook.Worksheets("监考安排").Range("A1:I27").Value = brr

    MsgBox "完成！"

    Set dAll = Nothing
    Set dTemp = Nothing
End Sub

djk1020

amzxfgh9632 发表于 2024-5-2 11:52
谢谢老师，目前测试可以支持12科，我有小想法，如果预先先设定主考教师，这样搭配起来不知道如何，谢谢老 ...

奇葩监考安排.rar (27.7 KB, 下载次数: 6)

2024-5-2 15:24 上传

点击文件名下载附件

更正了一个混搭bug，现在基本上没问题了，混搭也能快速得到。

djk1020

amzxfgh9632 发表于 2024-5-2 11:52
谢谢老师，目前测试可以支持12科，我有小想法，如果预先先设定主考教师，这样搭配起来不知道如何，谢谢老 ...

可以的，男+女，女+男，混搭<(男+女、男+男)、 ( 女+男、女+女）>，请测试一下满足要求不。