excel - 游泳混合泳接力时间仿真算法

我试图模拟这个website page
我的输入表如下：

现在，从输入表中提取值并按升序排列后，我在临时工作表中得到：

这就是我的结果表：

现在，我已经在排序过程后尝试了此操作（没有添加排序代码，因为这不是问题所在）：

Set rng = Union(wTime.Range("D6:D25"), wTime.Range("F6:F25"), wTime.Range("H6:H25"), wTime.Range("J6:J25"))
cnt1 = 1: cnt2 = 1: cnt3 = 1: cnt4 = 1

wTime.Range("A6:A25") = Empty   'Ticker

For i = 1 To 20

bckStroke(i) = wTemp.Range("A" & i + 1).Value
brstStroke(i) = wTemp.Range("C" & i + 1).Value
btrFly(i) = wTemp.Range("E" & i + 1).Value
frStyle(i) = wTemp.Range("G" & i + 1).Value

wTime.Range("A6:A25") = Empty

For Each cel In rng

If cel.Column = 4 And cel.Value = bckStroke(i) And cel.Value <> 0 And Trim(wTime.Cells(cel.Row, 1)) <> "Y" And cnt1 < 6 Then
    wRes.Cells((cnt1 + 5 + (cnt1 - 1) * 2) - 1, 4) = wTime.Cells(cel.Row, 2)    'Athlete Name
    wRes.Cells(cnt1 + 5 + (cnt1 - 1) * 2, 4) = bckStroke(i)                     'Time
    cnt1 = cnt1 + 1
    wTime.Cells(cel.Row, 1) = "Y"
End If

If cel.Column = 6 And cel.Value = brstStroke(i) And cel.Value <> 0 And Trim(wTime.Cells(cel.Row, 1)) <> "Y" And cnt2 < 6 Then
    wRes.Cells((cnt2 + 5 + (cnt2 - 1) * 2) - 1, 6) = wTime.Cells(cel.Row, 2)    'Athlete Name
    wRes.Cells(cnt2 + 5 + (cnt2 - 1) * 2, 6) = brstStroke(i)                    'Time
    cnt2 = cnt2 + 1
    wTime.Cells(cel.Row, 1) = "Y"
End If

If cel.Column = 8 And cel.Value = btrFly(i) And cel.Value <> 0 And Trim(wTime.Cells(cel.Row, 1)) <> "Y" And cnt3 < 6 Then
    wRes.Cells((cnt3 + 5 + (cnt3 - 1) * 2) - 1, 8) = wTime.Cells(cel.Row, 2)    'Athlete Name
    wRes.Cells(cnt3 + 5 + (cnt3 - 1) * 2, 8) = btrFly(i)                        'Time
    cnt3 = cnt3 + 1
    wTime.Cells(cel.Row, 1) = "Y"
End If

If cel.Column = 10 And cel.Value = frStyle(i) And cel.Value <> 0 And Trim(wTime.Cells(cel.Row, 1)) <> "Y" And cnt4 < 6 Then
    wRes.Cells((cnt4 + 5 + (cnt4 - 1) * 2) - 1, 10) = wTime.Cells(cel.Row, 2)   'Athlete Name
    wRes.Cells(cnt4 + 5 + (cnt4 - 1) * 2, 10) = frStyle(i)                      'Time
    cnt4 = cnt4 + 1
    wTime.Cells(cel.Row, 1) = "Y"
End If

Next cel

Next i

我只想知道最简单的逻辑，以获得期望的结果后，安排升序（参考临时表）应该很容易，但我似乎无法理解。
我现在知道的情况是：
每队应有独特的游泳运动员（即每队有4个独特的名字）
如果一个游泳运动员在其他组别中也有最好的表现，他也可以出现在其他组别中。（例如，马塞洛将出现在前4名，因为他在所有4个类别中都有最好的时间）
时间最短的小组应列在结果表的第一位我认为按升序排序可以解决这个问题，关键是从临时工单列表中选择合适的游泳者。

最佳答案

编辑：
四中继逻辑前提：在没有两个相同字符串的情况下获得所有可能的组合。然后把它们从低到大排序。我将执行以下操作：获取所有可能的组合及其和，如下所示：*组合可能仍然是错误的，因为它可能随您拥有多少数字而变化。这只是一个描述过程的指南

Sub Combinations()
    Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long, o As Long, p As Long, q As Long
    Dim CountComb As Long, lastrow As Long

    Range("K2").Value = Now - 5

    Application.ScreenUpdating = False

    CountComb = 0: lastrow = 6

    For i = 1 To 6: For j = 1 To 5
    For k = 1 To 6: For l = 1 To 6
    If Not (i = j Or i = k Or i = l Or j = k Or j = l Or k = l) Then

              Range("K" & lastrow).Value = Range("A" & i).Value & "/" & _
                                     Range("B" & j).Value & "/" & _
                                     Range("C" & k).Value & "/" & _
                                     Range("D" & l).Value
        lastrow = lastrow + 1
        CountComb = CountComb + 1
        End If
    Next: Next
    Next: Next

    Range("K1").Value = CountComb
    Range("K3").Value = Now + 21

    Application.ScreenUpdating = True
End Sub
Function TimeSum(Persons As String, Chr As String) As Double
Dim ArrayPersons() As String: ArrayPersons = Split(Persons, Chr)
Dim SumOfTime As Double
Dim ItemPerson As Variant
Dim NumberRoutines As Long: NumberRoutines = 2
Const SheetData = "Sheet1"
For Each ItemPerson In ArrayPersons
SumOfTime = Sheets(SheetData).Columns(NumberRoutines).Find(ItemPerson).Offset(0, -1).Value + SumOfTime
NumberRoutines = NumberRoutines + 2
Next ItemPerson
TimeSum = SumOfTime
End Function

也许你可以定义更好的子来做你想做的事情，但是，最后的代码可以引导你走上正确的道路。再想一想，你可以在字典里找到组合词。
[
[