algorithm - 从列表中选择项目

Question

问题:

在下面的格式中有 N 名足球运动员，表格将吐出每 11 名球员的组合。

每个 11 人阵容必须遵守以下限制条件。

它应该能够选择球员作为“核心”，这意味着他们将出现在 100% 的输出阵容中。

输入:

  A               B       C        D                 E
Name          Position  Team     Salary     Core Player? 1="Yes",0="No"
Darron Gibson   M        EVE    6500000              0
Riyad Mahrez    M        LEI    11700000             0
Andrej Kramaric F        LEI    6900000              0
Sadio Mané      M        SOT    12600000             0
Victor Anichebe F        WBA    5300000              1
Serge Gnabry    M        WBA    6300000              0
Dimitri Payet   M        WHM    13500000             0
Juan Mata       M        MUN    10700000             0
  .
  .
  .so on there is list of players

每个团队的限制条件:

Maximum Salary  100000000   Allowed per team

'These are the maximum and minimum no. of players for a position per team   
Position    Min   Max   
  G          1    1
  D          3    4
  M          3    5
  F          1    3

'there can be maximum no. of four players from a single team
' e.g. MUN (manchester united)          
Maximum Number of Players from one team     4   
Total number of players     11            'Total no. of players per team

输出示例:

    Player 1    Player 2    Player 3    Player 4    Player 5    Player 6    Player 7    Player 8    Player 9    Player 10   Player 11
    Player 1    Player 2    Player 3    Player 4    Player 5    Player 6    Player 7    Player 8    Player 9    Player 10   Player 12
    Player 1    Player 2    Player 3    Player 4    Player 5    Player 6    Player 7    Player 8    Player 9    Player 10   Player 13
    Player 1    Player 2    Player 3    Player 4    Player 5    Player 6    Player 7    Player 8    Player 9    Player 10   Player 14
.
.
.
.

'Update: Players can be repeated in another teams but no match for full line up is allowed 

 Like this is not allowed

Player 1    Player 2    Player 3    Player 4    Player 5    Player 6    Player 7    Player 8    Player 9    Player 10   Player 11
Player 1    Player 3    Player 2    Player 5    Player 4    Player 6    Player 7    Player 8    Player 9    Player 10   Player 11

Attached File

我的想法是先放置它们，然后检查约束条件，因为选择它们的顺序并不重要，并使它们正确直到满足条件，但这在每个阶段都变得复杂。

我尝试过的(不完整):

Option Explicit
Sub Teams()
Dim wi, wo, wt, ws As Worksheet
Dim i, j, l, d, m, ct, c, a, b, r As Long
Dim TotalG, TotalD, TotalM, TotalF, TotalSal, Sal, SalLeft, MaxTeam As Long
Dim Team, Pos, Name As String
Dim FinalRowI, FinalRowO As Long
Dim Drng As Range
Dim Mrng As Range

Set wi = Sheet1
Set wo = Sheet2
Set wt = Sheet3
Set ws = Sheet4

FinalRowI = wi.Range("A900000").End(xlUp).Row

TotalG = 0
TotalD = 0
TotalM = 0
TotalF = 0
Sal = 0
SalLeft = 0
TotalSal = wi.Range("H14").Value

    For i = 2 To FinalRowI

        Name = Trim(wi.Range("A" & i).Text)
        Pos = Trim(wi.Range("B" & i).Text)
        Team = Trim(wi.Range("C" & i).Text)
        Sal = wi.Range("D" & i).Value

        Select Case Pos

        Case "G"
            TotalG = TotalG + 1

        Case "D"
            TotalD = TotalD + 1

        Case "M"
            TotalM = TotalM + 1

        Case "F"
            TotalF = TotalF + 1

        Case Else
        End Select
    Next i

    MaxTeam = (WorksheetFunction.Min(CInt(TotalD), CInt(TotalM))) / 3

    MaxTeam = (WorksheetFunction.Min(CInt(MaxTeam), CInt(TotalG), CInt(TotalF)))

    MsgBox "MaxTeam " & MaxTeam
    MsgBox "G " & TotalG
    MsgBox "D " & TotalD
    MsgBox "M " & TotalM
    MsgBox "F " & TotalF

        m = 0
        d = 0
        c = 1
        ct = 1
        a = 1
        r = 1

        l = 3
        b = 6

        'Place all the Min Goalkeepers,Forwards, Mid, Defenders
        For i = 2 To FinalRowI

            Name = Trim(wi.Range("A" & i).Text)
            Pos = Trim(wi.Range("B" & i).Text)
            Team = Trim(wi.Range("C" & i).Text)
            Sal = wi.Range("D" & i).Value

            Select Case Pos

            Case "G"

                If ct <= MaxTeam Then
                    wo.Range("A" & ct) = Name
                    wt.Range("A" & ct) = Team
                    ws.Range("A" & ct) = Sal
                    ct = ct + 1
                Else: End If

            Case "D"

                If d <= 3 * MaxTeam And r <= MaxTeam Then
                    wo.Cells(r, l) = Name
                    wt.Cells(r, l) = Team
                    ws.Cells(r, l) = Sal
                        d = d + 1
                        If d Mod 3 = 0 Then
                            r = r + 1
                            l = 3
                        Else
                            l = l + 1
                        End If
                Else: End If

            Case "M"

                If m <= 3 * MaxTeam And a <= MaxTeam Then
                    wo.Cells(a, b) = Name
                    wt.Cells(a, b) = Team
                    ws.Cells(a, b) = Sal
                    m = m + 1
                        If m Mod 3 = 0 Then
                            a = a + 1
                            b = 6
                        Else
                            b = b + 1
                        End If
                Else: End If

            Case "F"

                If c <= MaxTeam Then
                    wo.Range("B" & c) = Name
                    wt.Range("B" & c) = Team
                    ws.Range("B" & c) = Sal
                    c = c + 1
                Else: End If

            Case Else
            End Select
        Next i

     Set Drng = wo.Range(Cells(1, 3), Cells(MaxTeam, 5))
     Set Mrng = wo.Range(Cells(1, 6), Cells(MaxTeam, 8))

        m = 8
        d = 8
        c = 0
        ct = 0
        a = 1
        b = 1

        l = 3
        b = 6

'For Rest of three Places
    For i = 2 To FinalRow

        Name = Trim(wi.Range("A" & i).Text)
        Pos = Trim(wi.Range("B" & i).Text)
        Team = Trim(wi.Range("C" & i).Text)
        Sal = wi.Range("D" & i).Value

        Select Case Pos

        Case "G"

        Case "D"
            For Each c In Drng

            Next j

        Case "M"

        Case "F"

        Case Else
        End Select
    Next i

End Sub

Answer 1

考虑一个 SQL 解决方案，该解决方案运行 11 人序列的随机迭代并验证每次迭代是否满足所有要求的条件。 MS Access 与其 Office 兄弟 MS Excel 配合得很好，可能是一个可行的解决方案。此外，任何 RDMS 都可以在下面的存储过程中运行。以下是事件的顺序和所需的对象。这是 MS Access accdb app没有任何可供您测试的选秀权。

表格

首先，创建一个最终表 SoccerPicks 来容纳所有 11 个成员球队，这些球队将在应用程序的生命周期中增长。它用于由下面的 VBA 模块调用的追加查询，在每个循环迭代中插入一个成功验证的团队记录。

交叉连接查询

其次，创建一个randomized Cross Join Query (返回一个选择集的所有可能组合)但每 11 个玩家表选择一个玩家并条件位置(G、D、M、F)计数。在 FROM 子句中，前四个对应四个核心球员，这些人将出现在每个团队中。复制他们的派生表或删除并复制一个随机派生表，因为其他 7 个已设置。

SELECT Player1, Player2, Player3, Player4, Player5, Player6, 
       Player7, Player8, Player9, Player10, Player11, 

       (t1.Salary + t2.Salary + t3.Salary + t4.Salary + t5.Salary + t6.Salary +
        t7.Salary + t8.Salary + t9.Salary + t10.Salary + t11.Salary) AS TeamSalary, 
       IIF(t1.Position = 'G', 1, 0) + IIF(t2.Position = 'G', 1, 0) +
       IIF(t3.Position = 'G', 1, 0) + IIF(t4.Position = 'G', 1, 0) + 
       IIF(t5.Position = 'G', 1, 0) + IIF(t6.Position = 'G', 1, 0) + 
       IIF(t7.Position = 'G', 1, 0) + IIF(t8.Position = 'G', 1, 0) + 
       IIF(t9.Position = 'G', 1, 0) + IIF(t10.Position = 'G', 1, 0) +
       IIF(t11.Position = 'G', 1, 0) AS GPosition, 

       IIF(t1.Position = 'D', 1, 0) + IIF(t2.Position = 'D', 1, 0) +
       IIF(t3.Position = 'D', 1, 0) + IIF(t4.Position = 'D', 1, 0) + 
       IIF(t5.Position = 'D', 1, 0) + IIF(t6.Position = 'D', 1, 0) +
       IIF(t7.Position = 'D', 1, 0) + IIF(t8.Position = 'D', 1, 0) + 
       IIF(t9.Position = 'D', 1, 0) + IIF(t10.Position = 'D', 1, 0) + 
       IIF(t11.Position = 'D', 1, 0) AS DPosition, 

       IIF(t1.Position = 'M', 1, 0) + IIF(t2.Position = 'M', 1, 0) +
       IIF(t3.Position = 'M', 1, 0) + IIF(t4.Position = 'M', 1, 0) +
       IIF(t5.Position = 'M', 1, 0) + IIF(t6.Position = 'M', 1, 0) +
       IIF(t7.Position = 'M', 1, 0) + IIF(t8.Position = 'M', 1, 0) + 
       IIF(t9.Position = 'M', 1, 0) + IIF(t10.Position = 'M', 1, 0) +
       IIF(t11.Position = 'M', 1, 0) AS MPosition, 

       IIF(t1.Position = 'F', 1, 0) + IIF(t2.Position = 'F', 1, 0) +
       IIF(t3.Position = 'F', 1, 0) + IIF(t4.Position = 'F', 1, 0) +
       IIF(t5.Position = 'F', 1, 0) + IIF(t6.Position = 'F', 1, 0) +
       IIF(t7.Position = 'F', 1, 0) + IIF(t8.Position = 'F', 1, 0) + 
       IIF(t9.Position = 'F', 1, 0) + IIF(t10.Position = 'F', 1, 0) +
       IIF(t11.Position = 'F', 1, 0) AS FPosition

FROM 
    (SELECT PlayerName as Player1, Position, Team, Salary    
     FROM Soccer 
     WHERE [Core Player] = True AND
           (SELECT Count(*) FROM Soccer sub 
            WHERE sub.ID <= Soccer.ID  
            AND sub.[Core Player] = True 
            AND Soccer.[Core Player] = True) = 1)  AS t1, 

    (SELECT PlayerName as Player2, Position, Team, Salary
     FROM Soccer 
     WHERE [Core Player] = True AND
           (SELECT Count(*) FROM Soccer sub 
            WHERE sub.ID <= Soccer.ID  
            AND sub.[Core Player] = True 
            AND Soccer.[Core Player] = True) = 2)  AS t2, 

    (SELECT PlayerName as Player3, Position, Team, Salary    
     FROM Soccer  
     WHERE [Core Player] = True AND
           (SELECT Count(*) FROM Soccer sub 
            WHERE sub.ID <= Soccer.ID  
            AND sub.[Core Player] = True 
            AND Soccer.[Core Player] = True) = 3)  AS t3, 

    (SELECT PlayerName as Player4, Position, Team, Salary
     FROM Soccer 
     WHERE [Core Player] = True AND
           (SELECT Count(*) FROM Soccer sub 
            WHERE sub.ID <= Soccer.ID  
            AND sub.[Core Player] = True 
            AND Soccer.[Core Player] = True) = 4)  AS t4, 

    (SELECT TOP 1 PlayerName AS Player5, Position, Team, Salary 
     FROM Soccer ORDER BY Rnd(ID))  AS t5, 

    (SELECT TOP 1 PlayerName AS Player6, Position, Team, Salary 
     FROM Soccer ORDER BY Rnd(ID))  AS t6, 

    (SELECT TOP 1 PlayerName AS Player7, Position, Team, Salary 
     FROM Soccer ORDER BY Rnd(ID))  AS t7, 

    (SELECT TOP 1 PlayerName AS Player8, Position, Team, Salary 
     FROM Soccer ORDER BY Rnd(ID))  AS t8, 

    (SELECT TOP 1 PlayerName AS Player9, Position, Team, Salary 
     FROM Soccer ORDER BY Rnd(ID))  AS t9, 

    (SELECT TOP 1 PlayerName AS Player10, Position, Team, Salary
     FROM Soccer ORDER BY Rnd(ID))  AS t10,

    (SELECT TOP 1 PlayerName AS Player11, Position, Team, Salary 
     FROM Soccer ORDER BY Rnd(ID))  AS t11

WHERE 

   IIF(t1.Position = 'G', 1, 0) + IIF(t2.Position = 'G', 1, 0) +
   IIF(t3.Position = 'G', 1, 0) + IIF(t4.Position = 'G', 1, 0) + 
   IIF(t5.Position = 'G', 1, 0) + IIF(t6.Position = 'G', 1, 0) + 
   IIF(t7.Position = 'G', 1, 0) + IIF(t8.Position = 'G', 1, 0) + 
   IIF(t9.Position = 'G', 1, 0) + IIF(t10.Position = 'G', 1, 0) +
   IIF(t11.Position = 'G', 1, 0) = 1 

AND
   IIF(t1.Position = 'D', 1, 0) + IIF(t2.Position = 'D', 1, 0) +
   IIF(t3.Position = 'D', 1, 0) + IIF(t4.Position = 'D', 1, 0) + 
   IIF(t5.Position = 'D', 1, 0) + IIF(t6.Position = 'D', 1, 0) +
   IIF(t7.Position = 'D', 1, 0) + IIF(t8.Position = 'D', 1, 0) + 
   IIF(t9.Position = 'D', 1, 0) + IIF(t10.Position = 'D', 1, 0) + 
   IIF(t11.Position = 'D', 1, 0) BETWEEN 3 AND 4

AND 
   IIF(t1.Position = 'M', 1, 0) + IIF(t2.Position = 'M', 1, 0) +
   IIF(t3.Position = 'M', 1, 0) + IIF(t4.Position = 'M', 1, 0) +
   IIF(t5.Position = 'M', 1, 0) + IIF(t6.Position = 'M', 1, 0) +
   IIF(t7.Position = 'M', 1, 0) + IIF(t8.Position = 'M', 1, 0) + 
   IIF(t9.Position = 'M', 1, 0) + IIF(t10.Position = 'M', 1, 0) +
   IIF(t11.Position = 'M', 1, 0) BETWEEN 3 AND 5

AND
   IIF(t1.Position = 'F', 1, 0) + IIF(t2.Position = 'F', 1, 0) +
   IIF(t3.Position = 'F', 1, 0) + IIF(t4.Position = 'F', 1, 0) +
   IIF(t5.Position = 'F', 1, 0) + IIF(t6.Position = 'F', 1, 0) +
   IIF(t7.Position = 'F', 1, 0) + IIF(t8.Position = 'F', 1, 0) + 
   IIF(t9.Position = 'F', 1, 0) + IIF(t10.Position = 'F', 1, 0) +
   IIF(t11.Position = 'F', 1, 0) BETWEEN 1 AND 3

AND 
  (t1.Salary + t2.Salary + t3.Salary + t4.Salary + t5.Salary + t6.Salary + 
   t7.Salary + t8.Salary + t9.Salary + t10.Salary + t11.Salary) <= 100000000;

VBA 模块

接下来是运行追加和删除查询的 VBA 模块(以删除不满足其他约束的失败记录)。注意 for 循环 50 次迭代。根据需要增加，知道有 11 位玩家的选择集很多。需要迭代，因为上述查询可能返回零，具体取决于随机抽取和 WHERE 逻辑条件。注意:前两个删除查询需要一个联合查询来堆叠上述第一个查询中的所有球员，以更好地汇总球队人数、球员人数和球队薪水总和。请参阅随附的应用程序。

Public Function IteratePicks()
    Dim db As Database
    Dim i As Integer

    Set db = CurrentDb

    For i = 1 To 50
        db.Execute "INSERT INTO SoccerPicks SELECT * FROM SoccerTeamPicksQ", dbFailOnError

        ' DELETING TEAMS WITH DUPLICATE PLAYERS
        db.Execute "DELETE FROM SoccerPicks" _
                    & " WHERE SoccerPicks.ID IN" _
                    & " (SELECT ID" _
                    & "  FROM (SELECT SoccerPicksUnionQ.ID, SoccerPicksUnionQ.Player, Count(*) AS PlayerCount" _
                    & "       FROM SoccerPicksUnionQ " _
                    & "  GROUP BY SoccerPicksUnionQ.ID, SoccerPicksUnionQ.Player" _
                    & "  HAVING Count(*) > 1) AS dT);", dbFailOnError    

        ' DELETING TEAMS WITH TEAM PLAYER COUNT > 4
        db.Execute "DELETE FROM SoccerPicks" _
                    & " WHERE SoccerPicks.ID IN" _
                    & " (SELECT ID AS MaxID" _
                    & "  FROM (SELECT SoccerPicksUnionQ.ID, SoccerPicksUnionQ.Team, Count(*) AS TeamCount" _
                    & "       FROM SoccerPicksUnionQ" _
                    & "       GROUP BY SoccerPicksUnionQ.ID, SoccerPicksUnionQ.Team)  AS dT" _
                    & "  GROUP BY ID" _
                    & "  HAVING Max(TeamCount) >= 4);", dbFailOnError

        ' DELETING TEAMS WITH SAME PLAYERS (I.E. SAME SALARY)
        db.Execute "DELETE FROM SoccerPicks" _
                    & " WHERE ID IN" _
                    & " (SELECT ID AS MaxID" _
                    & "  FROM SoccerPicks" _
                    & "  WHERE TeamSalary IN" _
                    & "         (SELECT sub.TeamSalary" _
                    & "         FROM SoccerPicks sub" _
                    & "         WHERE sub.ID < SoccerPicks.ID));", dbFailOnError
    Next i

    Set db = Nothing


    MsgBox "Successfully completed!", vbInformation
End Function