求助

supermouse24

这个不会死循环
逻辑：
1.新建3个人名字典。因为最多上3天班。
2.每天从字典扣人上班，扣完一本字典扣下一本。保证每个人都会被扣到。

Sub 随机排班()
    Set dic_name = CreateObject("scripting.dictionary")
    Set dic_name2 = CreateObject("scripting.dictionary")
    Set dic_name3 = CreateObject("scripting.dictionary")
   
    With Worksheets("sheet1")
        .Rows("4:8").ClearContents
        
        
        arr = .[a3].Resize(1, 15).Value
        For i = 1 To UBound(arr, 2)
            dic_name(i) = 0
            dic_name2(i) = 0
            dic_name3(i) = 0
        Next

        
        Randomize
        max_num = UBound(arr, 2) + 1
        min_num = 1
        
        For days_ = 1 To 5 '排班日子

                workers = 0
                Do While dic_name.Count > 0 And workers < 5 '一天安排多少人上班
                    on_work = Int((max_num - min_num) * Rnd + min_num)
                    If dic_name.exists(on_work) Then
                        dic_name.Remove (on_work)
                        .Cells(days_ + 3, on_work) = "√"
                        workers = workers + 1
                    End If
                    If workers = 5 Then
                        GoTo 下一天
                    End If
                Loop
                workers = 0
                Do While dic_name2.Count > 0 And workers < 5 '一天安排多少人上班
                    on_work = Int((max_num - min_num) * Rnd + min_num)
                    If dic_name2.exists(on_work) Then
                        dic_name2.Remove (on_work)
                        .Cells(days_ + 3, on_work) = "√"
                    End If
                    workers = workers + 1
                Loop
                workers = 0
                Do While dic_name3.Count > 0 And workers < 5 '一天安排多少人上班
                    on_work = Int((max_num - min_num) * Rnd + min_num)
                    If dic_name3.exists(on_work) Then
                        dic_name3.Remove (on_work)
                        .Cells(days_ + 3, on_work) = "√"
                    End If
                    workers = workers + 1
                Loop
下一天:

        Next
    End With


End Sub