排列以找到最好的团队

Question

我试图以不同的方式提出一些回应。我一直在研究排列，为团队寻找最佳价值，除非我似乎无法找到任何让我清楚了解我需要做什么的材料。初学者在excel中创建排列表

我想要完成的事情。我希望得到可能的梦幻足球队的前100名（或者更多，如果可能的话）。

我不太确定如何设置它，因为我需要每个排列包括每个位置如下QB，RB，RB，WR，WR，TE（6个启动器）。由于每个位置都有不同数量的球员，我不确定如何将所有这些放在一起或者最好的方法是什么，所以我已经请求帮助了！

我想要的结果是什么。

Position QB   RB   RB   WR   WR    TE   Total
Fantasy 350  110 115  220  120   125   1040

并在整个排列过程中继续使用上述格式，找出最佳团队。

玩家会来自以下不同的栏目：

qb               rb
peyton 350   jamaal 235
drew   345

我不确定这是否可行，但我找到了一个宏，它会给我一些可能的位置结果（QB，RB，WR等），但我似乎无法弄清楚如何将点数组合到位置并显示每个玩家在各自位置的所有排列。

再次感谢。

Answer 1

这不是算法的正确站点。它专门帮助编程。但是，我会尽力让你入门。请将以下每个步骤视为单独的任务。创建一个将执行任务1的宏。当它工作时，更新它以创建执行任务1和2的宏。我已尝试定义每个步骤，因此它是一个问题，您可以根据需要搜索答案。例如，对于第一步，在“[excel-vba]查找最后一列”中搜索Stackoverflow将提供相关的问题和答案，以显示此任务的最常用技术。

我假设您有一个包含每个位置玩家的工作表。像这样：

   A       B       C       D       E       F       G       H       ...
1  QB              RB              RB              WR              ...
2  Albert  100     Bernard 150     Charles 200     David   150
3  Eric    250     Fred    125     George  175     Ian     215
4      :               :                :              :               :                :              :                :

你说你现在有六个先发球员。这是否意味着一旦您理解了问题，您将添加更多玩家？无论哪种方式，第一项任务是确定职位数量。

有六个位置，第1行的最后一个值将在第11列，最后一列的值为12.使用不同的位置数，这些值将为N和N + 1，其中N + 1为偶数并且头寸数是（N + 1）/ 2.

你说每个位置会有不同数量的玩家。任务2是识别并记录每个位置的玩家数量。搜索“[excel-vba]查找最后一行”将提供各种技术。

我会创建一个动态数组，如：

Dim RowPlayerMax() As Long
ReDim RowPlayerMax(1 to NumPositions)

然后我会为每个位置循环并记录PositionNum*2中列RowPlayerMax(PositionNum)的最后一行。

您会注意到我没有向您展示该循环的代码。这是一个程序员互相帮助发展的网站。我告诉你如何将你的要求分成小步骤。如果我也向你展示了VBA，我也不会帮助你发展。你需要了解每一步的VBA，如果你自己发现了VBA，那么你的开发会更好。

您需要将每个位置数据的播放器加载到内存中以便快速访问。我会将所有这些数据加载到Variant，这将创建一个二维数组。第1行的第1,3,5等列将包含位置名称。第2行将包含第一组玩家名称和点数。数组RowPlayerMax将识别每个位置的最后一行。

我认为下一步是确定您希望生成排列的顺序。首先是最简单的序列。

您已拥有数组RowPlayerMax。您需要另一个大小相同的数组：RowPlayerCrnt。您已初始化RowPlayerMax。您将RowPlayerCrnt初始化为每个位置播放器表中第一个数据行的编号，即2.为RowPlayerMax数组创建一些值，您有：

Element           1    2     3    4     5    6
RowPlayerMax     20    5    12    3    15    9
RowPlayerCrnt     2    2     2    2     2    2

然后您进入Do While True循环。

Do循环中的第一个任务是记录RowPlayerCrnt定义的排列。根据我的示例数据，这是Albert，Bernard，Charles，David等，总共100 + 150 + 200 + 100 ....

Do循环中的第二个任务是生成下一个排列。您需要{1}}循环，从1到For或相反方向运行。我将从1到NumPositions。

您查看每个位置并检查其当前值与最大值。如果某个头寸的当前值小于最大值，则将其逐步退出并退出NumPositions循环。如果当前值等于最大值，则将其设置为第一个数据行并继续For循环。如果在不步进当前值的情况下退出For循环，则表示已生成每个排列。

考虑一下这意味着什么。第一个排列是For。在第一个循环中，检查位置1（2）的当前值与最大值（20）。由于2小于20，因此将一个加到2.第二个排列是2-2-2-2-2-2。第三种排列为3-2-2-2-2-2，依此类推，直到4-2-2-2-2-2。

对于20-2-2-2-2-2，位置1的当前值等于其最大值，因此将其设置为2并且循环继续考虑位置2.位置2的当前值低于其最大值，因此添加了一个它。这使得下一个排列为20-2-2-2-2-2。

这将一直持续到排列为2-3-2-2-2-2为止。无法增加任何这些当前值，因此已生成所有排列。

您可能需要在纸上完成此操作。一旦你掌握了正在发生的事情，你就会发现这是产生每个排列的一种非常简单的方法。

如果您对这一系列排列感到满意，那么就没有什么可做的了。您需要从每个位置的播放器表中提取信息并将其存储在Permutations表中。 Barrowc说，总数可能有最大值。如果这是正确的，您需要丢弃一些排列。

另一个可能的问题是，如果同一个玩家可以在多个位置玩。玩家John可能会出现在1号位置或2号位置，但是John出现在两个位置的排列都必须被丢弃。

如果您打算生成所有可能的排列，然后按总计对它们进行排序，比如说，生成顺序无关紧要。但是，如果要生成前100或200，序列确实很重要。在这种情况下，你可能会对每个位置的玩家进行排序并寻找排列：

20-5-12-3-15-9

在添加此序列的解释之前，我看到您的评论说您会对每个排列感到满意。无论如何，我可能已经给你足够的思考了。

编辑：其他建议和代码

在网上搜索＆＃34; Excel VBA教程＆＃34;。有很多可供选择，所以尝试一些，并完成一个符合您的学习风格。我更喜欢书。我参观了一个很好的图书馆并借了一些Excel VBA Primers，在家里试了一下然后买了我喜欢的那个。我无法提出建议，因为它符合我的学习风格，而你的学习风格可能与众不同。

它将完成我的答案，包括代码所以我已经这样做了。我创建了一个宏来执行步骤1然后第二个宏来执行步骤1,2和3等等，这是我推荐给任何新手的方法。当我不确定如何实现我寻求的结果时，我使用相同的技术。请注意，变量名称与上面的说明不完全相同。当我创建完整的宏而不是孤立的代码片段时，我觉得我原来的名字并不完全正确。

我创建了一个包含两个工作表的工作簿：PlayerPerPosition和Permutations。如果您不喜欢我的名字，请更改2-2-2-2-2-2 2-2-2-2-2-3 2-2-2-2-3-2 2-2-2-3-2-2 2-2-3-2-2-2 2-3-2-2-2-2 3-2-2-2-2-2 2-2-2-2-2-4 2-2-2-2-4-2 2-2-2-2-4-3 and so on. 语句。我为PlayerPerPosition生成了一些数据，我认为这些数据足以表示您的数据：

宏With Worksheets("xxx")确定列数并使用Test1将结果输出到立即窗口。打开Visual Basic编辑器时，立即窗口应位于底部的右侧。如果缺少，请单击 Ctrl + G 。该宏演示了两种技术。我已经包含了解释我正在做什么的评论，但我没有解释VBA。一旦您知道存在VBA语句，通常很容易查找并查找带有示例的完整描述。询问是否有必要，但你自己发现的越多，你发展技能的速度就越快。

宏Debug.Print确定并存储每个位置的最大行。然后它将整个工作表加载为一个数组。对于Test2和Test1，我使用Test2输出结果。如果我为自己编写这些排列的代码，我会一次性编写宏，因为我完全熟悉这种技术。但是我仍然会包含所有Debug.Print个问题。一个简单的错字。在步骤1或2中可能导致细微的错误，这可能导致后续步骤中的完全失败。在前进到下一步之前检查每一步可以避免这些问题。

宏Debug.Print以2-2-2-2-2-2,3-2-2-2-2-2等样式输出排列。使用我的样本数据，有62,208个排列在我的笔记本电脑上生成了七秒钟。没有进度指标。我会使用一个表单来表示进度，但我认为这些宏中有足够的想法而不引入表单。

宏Test3输出在我的笔记本电脑上生成了18秒的实际排列。

Test4

Answer 2

去年，我做了一个简单的版本。 如果您运行标准阵容（1QB，2RB，3WR，1TE）的组合，则在删除重复后将获得420种组合。

这些组合是严格的，因为它们不会“调整”到实时草稿。我使用ADP作为我希望在某个选秀位置上出现的人。同样，它很严格，因为当你的联盟成员在ADP之前达到选秀权时，它不能适应意外的选秀权。

假设我在10支球队联盟中排名第9。我在选择1.9,2.2,3.9,4.2等手动输入每个位置的值。这听起来很乏味，但你会开始看到模式，它需要大约一个小时来跋涉。然后，您可以对列进行求和。

我不明白你们所说的行话。但是如果你能够适应现场选秀，那么你将会摧毁任何一个偶然的联赛。换句话说，你真正想要的东西（我怀疑这是Draft Dominator应用程序可能有用的方式）。

至少，你将从你的努力中学到一些东西。例如，我的电子表格中的大多数最佳组合告诉我在他的ADP之前的第5轮，第1-2轮中选择Antonio Brown。男人如果你得到这样的1名球员，那将值得你花时间和精力。

Answer 3

编辑2 - 响应和更多代码

<强>响应

＆＃34;另外，你知道你是否可以从4列中获取位置并从中进行6位排列吗？＆＃34;是的，但我认为这不值得。

我认为你想要这个，因为玩家可以被置于RB和WR位置。 （1）我以不同的方式允许这一点，我认为这提供了更大的灵活性。 （2）这个要求会为每个排列的每个位置增加一个步骤。

如果您不同意，这就是您实现效果的方式。目前，该宏具有以下内容：

Position    QB     RB     RB     WR     WR     TE
Column      1      2      3      4      5      6
PppTable

Position    QB     RB     RB     WR     WR     TE
Column      1      2      3      4      5      6
RowPppCrnt  a      b      c      d      e      f

数组RowPppCrnt标识要从数组PppTable中选择的行。 a，b，c，d，e和f是PppTable中的行号，RowPppCrnt中的列号与PppTable中的列号匹配。

下面，PppTable只有4列，而RowPppCrnt仍有6个条目。新数组SwitchCol将RowPppCrnt中的列与PppTable中的列相关联。例如，对于RowPppCrnt中的第6列，SwitchCol中的第6列说明转到PppTable中的第4列。

Position    QB     RB     WR     TE
Column      1      2      3      4
PppTable

Position    QB     RB     RB     WR     WR     TE
Column      1      2      3      4      5      6
SwitchCol   1      2      2      3      3      4
RowPppCrnt  a      b      c      d      e      f

更多代码

在宏Test2中，我介绍了将范围加载到数组以提供更快访问的工具。相反的情况也是可能的。对于宏Test5，我添加了一个二维数组PermTable，其中包含200行，其中我累积了最多200个排列。

我引入了一个新常量Const PointsTotalMaxPermitted As Long = 1000。点值高于此最大值的排列将被拒绝。如果您不想要此设施，请将1000替换为一些不可能的高价值。否则，将1000替换为适当的限制。

我已经介绍了对同一位玩家不止一个位置的检查。对于我的测试数据，我使两个RB列和两个WR列相同。这就是我提出问题背后的要求的方式。这种方法的缺点是数据重复。优点是它不需要额外的代码，它允许玩家可以在多个位置玩。

如果排列通过了上述两个测试，则考虑添加到PermTable。如果排列是前200个之一，则总是添加。如果它不在前200并且其点值大于最低值的点值，即现有排列，旧排列将被新的覆盖。

只有在考虑了所有排列后，PermTable才会写入工作表。宏Test5比Test4快得多，因为它正在向工作表写入非常少的数据。 Test4在18秒内处理了62,208次permultations。 Test5在4秒内处理1,080,000个排列。

在下面的代码中，我保留了我的诊断代码，但已对其进行了评论。如果您想尝试该代码，则必须添加它使用的三个工作表。

Sub Test5()

  ' This macro saves the 200 permulations with the highest permitted totals.

  Const RowPppPosnName As Long = 1
  Const RowPppDataFirst As Long = 2
  Const PointsTotalMaxPermitted As Long = 1000

  Dim ColPppCrnt As Long
  Dim ColPppMax As Long
  Dim GenerationFinished As Boolean
  Dim NumPermsGenerated As Long
  Dim NumPosns As Long
  Dim PermCrnt() As Variant
  Dim PermCrntIsValid As Boolean
  Dim PermTable() As Variant
  Dim PointsTotalCrnt As Long
  Dim PointsTotalLowest As Long
  Dim PosnNumCrnt1 As Long
  Dim PosnNumCrnt2 As Long
  Dim PppTable As Variant
  'Dim RowNotTop200Crnt As Long
  Dim RowPermCrnt As Long
  Dim RowPermCrntMax As Long
  Dim RowPermLowestTotal As Long
  Dim RowPppCrnt() As Long
  Dim RowPppMax() As Long
  Dim RowPppMaxMax As Long
  'Dim RowRepeatCrnt As Long
  'Dim RowTooHighCrnt As Long
  Dim TimeStart As Single

  TimeStart = Timer   ' Seconds since midnight

  Application.ScreenUpdating = False

  With Worksheets("PlayerPerPosition")

    ColPppMax = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column

    NumPosns = ColPppMax / 2       ' I ought to check there are an even number of columns

    ReDim RowPppMax(1 To NumPosns)

    RowPppMaxMax = 0
    PosnNumCrnt1 = 1
    For ColPppCrnt = 2 To ColPppMax Step 2
      RowPppMax(PosnNumCrnt1) = .Cells(Rows.Count, ColPppCrnt).End(xlUp).Row
      If RowPppMaxMax < RowPppMax(PosnNumCrnt1) Then
        ' If this position has more rows than any previous position, record new maximum row
        RowPppMaxMax = RowPppMax(PosnNumCrnt1)
      End If
      PosnNumCrnt1 = PosnNumCrnt1 + 1
    Next

    PppTable = .Range(.Cells(1, 1), .Cells(RowPppMaxMax, ColPppMax)).Value

  End With

   ' Initialise current row table
  ReDim RowPppCrnt(1 To NumPosns)
  For PosnNumCrnt1 = 1 To NumPosns
    RowPppCrnt(PosnNumCrnt1) = RowPppDataFirst
  Next

  ' Size arrays to hold current permutation prior to validation and
  ' the 200 permutation with the highest permitted totals.
  ' Note with 2D arrays it is conventional for the first dimension to
  ' be for columns and the second dimension to be for rows.  Arrays
  ' holded from ranges or to be loaded to ranges are the other way
  ' round.
  ReDim PermCrnt(1 To NumPosns)
  ReDim PermTable(1 To 200, 1 To NumPosns + 1)     ' Extra column for total

  NumPermsGenerated = 0
  RowPermCrntMax = 0
  'RowTooHighCrnt = 0
  'RowRepeatCrnt = 0
  'RowNotTop200Crnt = 0

  'Worksheets("Too High").Cells.EntireRow.Delete     ' Delete any previous output
  'Worksheets("Repeat").Cells.EntireRow.Delete
  'Worksheets("Not Top 200").Cells.EntireRow.Delete
  'Worksheets("Permutations").Cells.EntireRow.Delete

  Do While True

    ' Generate current permulation from indices
    PermCrntIsValid = True  ' Assume current permutation is valid until find otherwise
    PointsTotalCrnt = 0
    ColPppCrnt = 1
    For PosnNumCrnt1 = 1 To NumPosns
      PermCrnt(PosnNumCrnt1) = PppTable(RowPppCrnt(PosnNumCrnt1), ColPppCrnt)
      ColPppCrnt = ColPppCrnt + 1
      PointsTotalCrnt = PointsTotalCrnt + PppTable(RowPppCrnt(PosnNumCrnt1), ColPppCrnt)
      ColPppCrnt = ColPppCrnt + 1
    Next
    NumPermsGenerated = NumPermsGenerated + 1

    ' Check points total not higher than maximum
    If PointsTotalCrnt > PointsTotalMaxPermitted Then
      PermCrntIsValid = False
      'RowTooHighCrnt = RowTooHighCrnt + 1
      'If RowTooHighCrnt < 65537 Then
      '  With Worksheets("Too High")
      '    For PosnNumCrnt1 = 1 To NumPosns
      '      .Cells(RowTooHighCrnt, PosnNumCrnt1) = PermCrnt(PosnNumCrnt1)
      '    Next
      '    .Cells(RowTooHighCrnt, NumPosns + 1) = PointsTotalCrnt
      '  End With
      'End If
    End If

    ' Check player not repeated
    If PermCrntIsValid Then
      For PosnNumCrnt1 = 1 To NumPosns - 1
        For PosnNumCrnt2 = PosnNumCrnt1 + 1 To NumPosns
          If PermCrnt(PosnNumCrnt1) = PermCrnt(PosnNumCrnt2) Then
            ' Same player in two positions
            PermCrntIsValid = False
            Exit For
          End If
        Next
        If Not PermCrntIsValid Then
          'RowRepeatCrnt = RowRepeatCrnt + 1
          'If RowRepeatCrnt < 65537 Then
          '  With Worksheets("Repeat")
          '    For PosnNumCrnt2 = 1 To NumPosns
          '      .Cells(RowRepeatCrnt, PosnNumCrnt2) = PermCrnt(PosnNumCrnt2)
          '    Next
          '    .Cells(RowRepeatCrnt, NumPosns + 1) = PointsTotalCrnt
          '  End With
          'End If
          Exit For
        End If
      Next
    End If

    If PermCrntIsValid Then
      If RowPermCrntMax < UBound(PermTable, 1) Then
        ' Permutations table is not full so save current permulation in
        ' next available row.
        RowPermCrntMax = RowPermCrntMax + 1
        For PosnNumCrnt1 = 1 To NumPosns
          PermTable(RowPermCrntMax, PosnNumCrnt1) = PermCrnt(PosnNumCrnt1)
        Next
        PermTable(RowPermCrntMax, NumPosns + 1) = PointsTotalCrnt
        If RowPermCrntMax = 1 Then
          ' This is first permutation to be saved.  Record as lowest
          PointsTotalLowest = PointsTotalCrnt
          RowPermLowestTotal = RowPermCrntMax
        Else
          ' Check for new lowest total
          If PointsTotalLowest > PointsTotalCrnt Then
            PointsTotalLowest = PointsTotalCrnt
            RowPermLowestTotal = RowPermCrntMax
          End If
          If RowPermCrntMax = UBound(PermTable, 1) Then
            ' Have just filled Permutations table
            With Worksheets("Permutations")
             .Range(.Cells(1, 1), _
                    .Cells(UBound(PermTable, 1), NumPosns + 1)).Value = PermTable
            End With
          End If
        End If
      Else
        ' Permutations table is full so only save current permulation
        ' if its points total is greater than lowest in table
        If PointsTotalCrnt > PointsTotalLowest Then
          ' Replace permutation with lowest total with with current permutation
          For PosnNumCrnt1 = 1 To NumPosns
            PermTable(RowPermLowestTotal, PosnNumCrnt1) = PermCrnt(PosnNumCrnt1)
          Next
          PermTable(RowPermLowestTotal, NumPosns + 1) = PointsTotalCrnt
          ' Find new lowest total
          ' Initialise lowest from first row in table then search rest of table
          PointsTotalLowest = PermTable(1, NumPosns + 1)
          RowPermLowestTotal = 1
          For RowPermCrnt = 2 To UBound(PermTable, 1)
            If PointsTotalLowest > PermTable(RowPermCrnt, NumPosns + 1) Then
              PointsTotalLowest = PermTable(RowPermCrnt, NumPosns + 1)
              RowPermLowestTotal = RowPermCrnt
            End If
          Next
        Else
          'RowNotTop200Crnt = RowNotTop200Crnt + 1
          'If RowNotTop200Crnt < 65537 Then
          '  With Worksheets("Not Top 200")
          '    For PosnNumCrnt1 = 1 To NumPosns
          '      .Cells(RowNotTop200Crnt, PosnNumCrnt1) = PermCrnt(PosnNumCrnt1)
          '    Next
          '    .Cells(RowNotTop200Crnt, NumPosns + 1) = PointsTotalCrnt
          '    .Cells(RowNotTop200Crnt, NumPosns + 2) = PermTable(RowPermLowestTotal, NumPosns + 1)
          '  End With
          'End If
        End If  ' Current permutation to replace lowest
      End If  ' Permutation table full
    End If  ' PermCrntIsValid

    ' Generate next permulation index
    GenerationFinished = True     ' Assume finishe until find otherwise
    For PosnNumCrnt1 = 1 To NumPosns
      If RowPppCrnt(PosnNumCrnt1) < RowPppMax(PosnNumCrnt1) Then
        RowPppCrnt(PosnNumCrnt1) = RowPppCrnt(PosnNumCrnt1) + 1
        GenerationFinished = False
        Exit For
      End If
      RowPppCrnt(PosnNumCrnt1) = RowPppDataFirst
    Next
    If GenerationFinished Then
      Exit Do
    End If

  Loop  ' until all permutation have been generated

  With Worksheets("Permutations")

    .Cells.EntireRow.Delete     ' Delete any previous output

    ' Generate header row
    RowPermCrnt = 1
    PosnNumCrnt1 = 1   ' Uses as column number for Permutations worksheets
    For ColPppCrnt = 1 To ColPppMax Step 2
      .Cells(RowPermCrnt, PosnNumCrnt1).Value = PppTable(RowPppPosnName, ColPppCrnt)
      PosnNumCrnt1 = PosnNumCrnt1 + 1
    Next
    With .Cells(RowPermCrnt, NumPosns + 1)
      .Value = "Total"
      .HorizontalAlignment = xlRight
    End With
    .Range(.Cells(1, 1), .Cells(1, NumPosns + 1)).Font.Bold = True

    RowPermCrnt = RowPermCrnt + 1

     ' Write Permutation table to worksheet
    .Range(.Cells(2, 1), _
           .Cells(UBound(PermTable, 1) + 1, NumPosns + 1)).Value = PermTable

  End With

  Debug.Print "Duration " & Format(Timer - TimeStart, "##0.00")
  Debug.Print "Number of permutations generated " & NumPermsGenerated

End Sub