Question

我正在尝试模拟此website page

的I / O.

我的输入表如下所示：

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

这就是我的结果表：

现在我在排序过程后尝试了这个（没有添加代码进行排序，因为它不是问题）：

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个独特的名字）
如果游泳运动员在其他类别中也有最佳时间，也可以出现在其他队伍中。（例如，Marcelo将出现在前4名球队中，因为他在所有4个类别中都有最佳成绩）
最短时间的团队应该在结果表的列表中排在第1位。我认为按升序排序可以解决这个问题，即从临时表单中选择合适的游泳运动员。

Answer 1

修改

4.继电器逻辑前提： 在没有2个相同字符串的情况下获得所有组合。然后将它们从最低到最大排序。 我会执行以下操作：获取所有可能的组合及其总和与以下内容：*组合可能仍然是错误的，因为它可能变化到多少你可能拥有的数字。这只是描述流程的指南

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

也许你可以更好地定义sub来做你想要的，但是，最后的编码可以指导你走正确的道路。在第二个想法中，您可以在字典中获得组合。
[ [

游泳混合中继时间仿真算法

1 个答案: