这不是算法的正确站点。它专门提供编程帮助。但是，我会尽力让你开始。请将以下每个步骤视为单独的任务。创建一个将执行任务 1 的宏。当它工作时，更新它以创建一个执行任务 1 和 2 的宏。我已尝试定义每个步骤，以便它是一个问题，您可以在必要时搜索答案。例如，对于第一步，在 Stackoverflow 中搜索“[excel-vba] Find last column”将给出相关问题和答案，展示了该任务最常用的技术。
我假设您有一个包含每个位置的球员的工作表。像这样的：
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] Find last row”会给出多种技巧。
我会创建一个动态数组，例如：
Dim RowPlayerMax() As Long
ReDim RowPlayerMax(1 to NumPositions)
然后我会循环每个位置，并在RowPlayerMax(PositionNum) 中记录PositionNum*2 列的最后一行。
您会注意到我没有向您展示该循环的代码。这是一个程序员互相帮助开发的网站。我正在向您展示如何将您的需求分解为小步骤。如果我也向您展示 VBA，我将不会帮助您开发。您需要了解每个步骤的 VBA，如果您自己发现 VBA，对您的开发会更好。
您需要将每个位置的球员数据加载到内存中以便快速访问。我会将所有这些数据加载到 Variant 中，这将创建一个二维数组。第 1 行的第 1、3、5 列等将包含职位名称。第 2 行将包含第一组玩家姓名和分数。数组RowPlayerMax 将标识每个位置的最后一行。
我认为下一步是确定您希望生成排列的顺序。首先是最简单的序列。
您已经拥有数组RowPlayerMax。您需要另一个相同大小的数组：RowPlayerCrnt。你已经初始化了RowPlayerMax。您将 RowPlayerCrnt 初始化为 Player Per Position 表中第一个数据行的编号，即 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 到 NumPositions 或相反方向的 For 循环。我将从 1 转到 NumPositions。
您查看每个位置并检查其当前值与最大值。如果某个位置的当前值小于最大值，则将其加一并退出For 循环。如果当前值等于最大值，则将其设置为第一个数据行并继续 For 循环。如果您退出 For 循环而不步进当前值，则您已经生成了每个排列。
考虑一下这意味着什么。第一个排列是2-2-2-2-2-2。在第一个循环中，根据最大值 (20) 检查位置 1 (2) 的当前值。由于 2 小于 20，因此将 1 添加到 2。第二个排列是 3-2-2-2-2-2。第三个排列是4-2-2-2-2-2，以此类推，直到20-2-2-2-2-2。
对于20-2-2-2-2-2，位置 1 的当前值等于其最大值，因此将其设置为 2，循环继续考虑位置 2。位置 2 的当前值低于其最大值，因此将其加一.这给出了下一个排列为2-3-2-2-2-2。
这将一直持续到排列为20-5-12-3-15-9。不可能增加这些当前值中的任何一个，因此所有排列都已生成。
您可能需要在纸上完成这项工作。一旦你掌握了正在发生的事情，你会发现这是一种生成每个排列的非常简单的方法。
如果您对这个排列顺序感到满意，那就没有什么可做的了。您需要从 Player per Position 表中提取信息并将其存储在您的 Permutations 表中。 Barrowc 说总数可能有一个最大值。如果这是正确的，您需要丢弃一些排列。
另一个可能的问题是，如果同一个球员可以踢多个位置。玩家 John 可能会出现在位置 1 或位置 2，但 John 出现在两个位置的排列必须被丢弃。
如果您打算生成所有可能的排列，然后按总数对它们进行排序，例如，生成顺序无关紧要。但是，如果您想生成前 100 个或 200 个，则顺序很重要。在这种情况下，您可能会对每个位置的玩家进行排序并寻求排列：
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.
在添加此序列的解释之前，我看到您的评论说您会对每个排列感到满意。无论如何，我可能已经给了你足够的思考。
编辑：附加建议和代码
在网上搜索“Excel VBA 教程”。有很多可供选择，因此请尝试一些并完成与您的学习风格相匹配的一个。我更喜欢书。我参观了一个不错的图书馆，借了几本 Excel VBA Primers，在家里试用，然后买了我喜欢的那个。我无法提出建议，因为它符合我的学习风格，而你的可能不同。
包含代码将完成我的回答，所以我已经这样做了。我创建了一个宏来执行步骤 1，然后创建第二个宏来执行步骤 1、2 和 3，依此类推，这是我向任何新手推荐的方法。当我不确定如何达到我所寻求的结果时，我会使用相同的技术。请注意，变量名称与上面的解释并不完全相同。当我创建整个宏而不是孤立的代码片段时，我觉得我原来的名字不太对。
我创建了一个包含两个工作表的工作簿：PlayerPerPosition 和 Permutations。如果您不喜欢我的名字，请更改 With Worksheets("xxx") 语句。我为 PlayerPerPosition 生成了一些数据，我认为这些数据足以代表您的数据：
宏Test1 确定列数并使用Debug.Print 将结果输出到即时窗口。当您打开 Visual Basic 编辑器时，立即窗口应该位于底部的右侧。如果缺少，请单击 Ctrl+G。这个宏演示了两种技术。我已经包含了 cmets 来解释我在做什么，但我没有解释 VBA。一旦您知道存在 VBA 语句，通常很容易查找它并找到带有示例的完整描述。如有必要，请询问，但您自己发现的越多，您发展技能的速度就越快。
宏Test2 确定并存储每个位置的最大行数。然后它将整个工作表加载为一个数组。对于Test1 和Test2，我使用Debug.Print 来输出结果。如果我为自己编写这些排列的生成，我会一口气编写宏，因为我对这项技术非常满意。但是我仍然会包含所有Debug.Print 声明。一个简单的错字。在步骤 1 或 2 中可能会导致细微的错误，从而可能导致后续步骤完全失败。在进行下一步之前检查每个步骤可以避免此类问题。
Macro Test3 以 2-2-2-2-2-2、3-2-2-2-2-2 等样式输出排列。根据我的样本数据，共有 62,208 个排列在我的笔记本电脑上生成 7 秒。没有进度指示器。我会用一个表格来表示进度，但我认为这些宏中有足够的想法，没有引入表格。
Macro Test4 输出在我的笔记本电脑上需要 18 秒才能生成的实际排列。
Option Explicit
Sub Test1()
' * Task 1 is to discover the number of columns in worksheet
' PlayerPerPosition. I demonstrate two techniques.
' * Technique 1 which uses the VBA equivalent of Ctrl+Left is
' the most popular technique judging from how often it is used
' in answers on this site. However, like all other techniques,
' it does not work in every situation.
' * The Find method is the most widely applicable technique although,
' as the second example shows, you must be careful how you search.
Dim ColPppMax As Long
With Worksheets("PlayerPerPosition")
' Use VBA equivalenent of Ctrl+Left to find last value in row 1
ColPppMax = .Cells(1, Columns.Count).End(xlToLeft).Column
' Maximum used column is one more than last column with a value in header row
ColPppMax = ColPppMax + 1
Debug.Print ColPppMax
' Use Find to find last column
' Note I am searching by columns
ColPppMax = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
Debug.Print ColPppMax
' See what happens if I search by rows
ColPppMax = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Column
Debug.Print ColPppMax
End With
End Sub
Sub Test2()
' * Task 2 is save the number of rows per position in worksheet
' PlayerPerPosition. I use the VBA equivalement of Ctrl+Up.
' * Task 3 is to load the whole of worksheet PlayerPerPosition to
' an array. For this I need to know the maximum used row for
' any position.
Dim ColPppCrnt As Long
Dim ColPppMax As Long
Dim NumPosns As Long
Dim PosnNumCrnt As Long
Dim PppTable As Variant
Dim RowPppMax() As Long
Dim RowPppCrnt As Long
Dim RowPppMaxMax As Long
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
PosnNumCrnt = 1
For ColPppCrnt = 2 To ColPppMax Step 2
RowPppMax(PosnNumCrnt) = .Cells(Rows.Count, ColPppCrnt).End(xlUp).Row
If RowPppMaxMax < RowPppMax(PosnNumCrnt) Then
' If this position has more rows than any previous position, record new maximum row
RowPppMaxMax = RowPppMax(PosnNumCrnt)
End If
PosnNumCrnt = PosnNumCrnt + 1
Next
'Output maximum row for each column
Debug.Print "Position ";
For PosnNumCrnt = 1 To NumPosns
Debug.Print Right(" " & PosnNumCrnt, 3);
Next
Debug.Print
Debug.Print " Max Row ";
For PosnNumCrnt = 1 To NumPosns
Debug.Print Right(" " & RowPppMax(PosnNumCrnt), 3);
Next
Debug.Print
' Load worksheet to variant as two-dimensional array
PppTable = .Range(.Cells(1, 1), .Cells(RowPppMaxMax, ColPppMax)).Value
End With
' Display Players Per Position table
For RowPppCrnt = 1 To RowPppMaxMax
For ColPppCrnt = 1 To ColPppMax Step 2
' Assume maximum of six characters per player name and
' maximum of 9999 for number of points
Debug.Print Left(PppTable(RowPppCrnt, ColPppCrnt) & Space(6), 6) & " " & _
Right(" " & PppTable(RowPppCrnt, ColPppCrnt + 1), 3) & " ";
Next
Debug.Print
Next
End Sub
Sub Test3()
' This macro generates the indices into the Ppp Table from which the
' actual permutations will be generated.
' If you have multi-row headers, using constants makes the code easy to change.
Const RowPppDataFirst As Long = 2
Dim ColPppCrnt As Long
Dim ColPppMax As Long
Dim GenerationFinished As Boolean
Dim NumPosns As Long
Dim PermStr As String
Dim PosnNumCrnt As Long
Dim PppTable As Variant
Dim RowPermCrnt As Long
Dim RowPppCrnt() As Long
Dim RowPppMax() As Long
Dim RowPppMaxMax As Long
Dim TimeStart As Single
TimeStart = Timer ' Seconds since midnight
' Stops screen flash and speeds up macro when writing to worksheet
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
PosnNumCrnt = 1
For ColPppCrnt = 2 To ColPppMax Step 2
RowPppMax(PosnNumCrnt) = .Cells(Rows.Count, ColPppCrnt).End(xlUp).Row
If RowPppMaxMax < RowPppMax(PosnNumCrnt) Then
' If this position has more rows than any previous position, record new maximum row
RowPppMaxMax = RowPppMax(PosnNumCrnt)
End If
PosnNumCrnt = PosnNumCrnt + 1
Next
PppTable = .Range(.Cells(1, 1), .Cells(RowPppMaxMax, ColPppMax)).Value
End With
' Initialise current row table
ReDim RowPppCrnt(1 To NumPosns)
For PosnNumCrnt = 1 To NumPosns
RowPppCrnt(PosnNumCrnt) = RowPppDataFirst
Next
RowPermCrnt = 1
With Worksheets("Permutations")
Do While True
' Output current permutation
PermStr = RowPppCrnt(1)
For PosnNumCrnt = 2 To NumPosns
PermStr = PermStr & "-" & RowPppCrnt(PosnNumCrnt)
Next
.Cells(RowPermCrnt, 1).Value = PermStr
RowPermCrnt = RowPermCrnt + 1
' Generate next permulation index
GenerationFinished = True ' Assume finishe until find otherwise
For PosnNumCrnt = 1 To NumPosns
If RowPppCrnt(PosnNumCrnt) < RowPppMax(PosnNumCrnt) Then
RowPppCrnt(PosnNumCrnt) = RowPppCrnt(PosnNumCrnt) + 1
GenerationFinished = False
Exit For
End If
RowPppCrnt(PosnNumCrnt) = RowPppDataFirst
Next
If GenerationFinished Then
Exit Do
End If
Loop
End With
Debug.Print "Duration " & Format(Timer - TimeStart, "##0.00")
End Sub
Sub Test4()
' This macro generates actual permutations.
Const RowPppPosnName As Long = 1
Const RowPppDataFirst As Long = 2
Dim ColPppCrnt As Long
Dim ColPppMax As Long
Dim GenerationFinished As Boolean
Dim NumPosns As Long
Dim PointsTotal As Long
Dim PosnNumCrnt As Long
Dim PppTable As Variant
Dim RowPermCrnt As Long
Dim RowPppCrnt() As Long
Dim RowPppMax() As Long
Dim RowPppMaxMax 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
PosnNumCrnt = 1
For ColPppCrnt = 2 To ColPppMax Step 2
RowPppMax(PosnNumCrnt) = .Cells(Rows.Count, ColPppCrnt).End(xlUp).Row
If RowPppMaxMax < RowPppMax(PosnNumCrnt) Then
' If this position has more rows than any previous position, record new maximum row
RowPppMaxMax = RowPppMax(PosnNumCrnt)
End If
PosnNumCrnt = PosnNumCrnt + 1
Next
PppTable = .Range(.Cells(1, 1), .Cells(RowPppMaxMax, ColPppMax)).Value
End With
' Initialise current row table
ReDim RowPppCrnt(1 To NumPosns)
For PosnNumCrnt = 1 To NumPosns
RowPppCrnt(PosnNumCrnt) = RowPppDataFirst
Next
With Worksheets("Permutations")
.Cells.EntireRow.Delete ' Delete any previous output
' Generate header row
RowPermCrnt = 1
PosnNumCrnt = 1 ' Uses as column number for Permutations worksheets
For ColPppCrnt = 1 To ColPppMax Step 2
.Cells(RowPermCrnt, PosnNumCrnt).Value = PppTable(RowPppPosnName, ColPppCrnt)
PosnNumCrnt = PosnNumCrnt + 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
Do While True
' Output current permutation
PointsTotal = 0
ColPppCrnt = 1
For PosnNumCrnt = 1 To NumPosns
.Cells(RowPermCrnt, PosnNumCrnt).Value = PppTable(RowPppCrnt(PosnNumCrnt), ColPppCrnt)
ColPppCrnt = ColPppCrnt + 1
PointsTotal = PointsTotal + PppTable(RowPppCrnt(PosnNumCrnt), ColPppCrnt)
ColPppCrnt = ColPppCrnt + 1
Next
.Cells(RowPermCrnt, NumPosns + 1).Value = PointsTotal
RowPermCrnt = RowPermCrnt + 1
' Generate next permulation index
GenerationFinished = True ' Assume finishe until find otherwise
For PosnNumCrnt = 1 To NumPosns
If RowPppCrnt(PosnNumCrnt) < RowPppMax(PosnNumCrnt) Then
RowPppCrnt(PosnNumCrnt) = RowPppCrnt(PosnNumCrnt) + 1
GenerationFinished = False
Exit For
End If
RowPppCrnt(PosnNumCrnt) = RowPppDataFirst
Next
If GenerationFinished Then
Exit Do
End If
Loop
End With
Debug.Print "Duration " & Format(Timer - TimeStart, "##0.00")
End Sub