如何在Excel中为多场赛事及多名车手生成公平赛程？

每年我都会为朋友举办多场Scalextric赛事之夜，想开发一款Excel表格，实现简单输入就能生成赛事赛程，同时跟踪每场比赛的得分和排名。之前手动生成赛程、记录得分，不仅耗时还容易出错——曾出现过部分车手参赛次数不均、单场重复参赛的问题。我们的情况通常是车手数量多于赛道车道数（比如10名车手但只有6条车道），所以需要生成公平的赛程，满足两个核心要求：

• 每位车手参赛次数相同
• 每位车手跑过所有车道
  举个例子：需要举办10场比赛，确保10名车手各自在1-6号车道都参赛一次。

理想功能 #

• 输入信息：车手姓名（可自动统计车手数量）、赛道车道数（有时是2、4或6条）、赛事场数
• 运行宏生成矩阵式赛程：顶部为赛事编号，侧边为车道编号，对应位置填充车手姓名
• 输入每场比赛的排名（1/2/3名等）后，自动生成车手得分表

当前进展与问题 #

我已经能完成第1、3部分的编码，但对第2部分的赛程生成毫无头绪。目前仅实现了从列表随机选取车手生成赛程，但没有参赛次数等校验逻辑。

我尝试编写了如下VBA代码，但宏在生成赛程后期会陷入无限循环，原因是剩余位置找不到符合条件的车手（代码会检查车手未在本场赛事及对应车道重复参赛）：

Private Sub schedule()
last_row = Sheets("Info").Range("D1").End(xlDown).Row
Dim racerslist()
Dim index As Integer
Dim racer As String
Dim nolanes As Integer
Dim srch1 As Range
Dim srch2 As Range
Dim cel As Range

nolanes = Sheets("Info").Cells(2, 2).Value
ReDim racerslist(last_row - 2, 0)
For i = 0 To last_row - 2
    racerslist(i, 0) = Sheets("Info").Range("D" & i + 2)
Next
Sheets("Schedule").Select

For i = 1 To last_row - 1
    For j = 1 To nolanes
         index = Int((last_row - 1) * Rnd)
         racer = racerslist(index, 0)
            
            Set srch1 = Range(Cells(2, i + 2), Cells(j, i + 2))
            For Each cel In srch1
                If InStr(1, cel.Value, racer) > 0 Then
                    setfound = 1
                End If
            Next
            Set srch2 = Range(Cells(j + 1, 3), (Cells(j + 1, i + 2)))
            For Each cel In srch2
                If InStr(1, cel.Value, racer) > 0 Then
                    setfound = 1
                End If
            Next
            
            If setfound = 1 Then
                j = j - 1
                setfound = 0
            Else
                Cells(j + 1, i + 2).Value = racer
            
            End If
        
    Next
Next

End Sub

内容的提问来源于stack exchange，提问作者Chris Birmingham