如何自动生成符合条件的冰球联盟分队组合方案

方法1：VBA宏（推荐，适用于所有Excel版本） #

这是最灵活高效的方案，能自动生成所有去重后的有效组合。

操作步骤 #

1. 打开目标Excel文件，按Alt + F11打开VBA编辑器。
2. 右键点击左侧工作簿名称，选择插入 → 模块。
3. 将以下代码粘贴到模块窗口中。
4. 返回Excel界面，按Alt + F8调用宏，输入总队伍数和分队数量即可生成结果。

VBA代码 #

Sub GenerateDivisionCombinations()
    Dim totalTeams As Integer, divisions As Integer
    Dim minPlayers As Integer, maxPlayers As Integer
    Dim remain As Integer, maxAdd As Integer
    Dim result As Collection
    Dim tempArr() As Integer, sortedArr() As Integer
    Dim i As Integer, j As Integer
    Dim key As String, outputRow As Integer
    
    ' 读取输入（可直接修改数值，或从单元格读取）
    totalTeams = InputBox("请输入总队伍数：")
    divisions = InputBox("请输入分队数量：")
    minPlayers = 6
    maxPlayers = 9
    
    ' 校验是否存在有效组合
    remain = totalTeams - divisions * minPlayers
    maxAdd = divisions * (maxPlayers - minPlayers)
    If remain < 0 Or remain > maxAdd Then
        MsgBox "不存在符合条件的分队组合！"
        Exit Sub
    End If
    
    Set result = New Collection
    
    ' 递归生成所有合法的额外人数分配方案
    GenerateCombinations remain, divisions, 0, tempArr, result
    
    ' 输出结果到工作表（从D1开始）
    outputRow = 1
    Cells(outputRow, 4).Value = "符合条件的分队组合"
    outputRow = outputRow + 1
    
    For Each item In result
        sortedArr = Split(item, ",")
        ' 转换为实际分队人数（基础6人+额外分配数）
        For i = LBound(sortedArr) To UBound(sortedArr)
            sortedArr(i) = CInt(sortedArr(i)) + minPlayers
        Next i
        ' 输出为标准括号格式
        Cells(outputRow, 4).Value = "(" & Join(sortedArr, ",") & ")"
        outputRow = outputRow + 1
    Next item
    
    MsgBox "生成完成，共" & result.Count & "种组合"
End Sub

' 递归生成所有满足总和要求的额外人数分配
Sub GenerateCombinations(ByVal target As Integer, ByVal count As Integer, ByVal currentSum As Integer, tempArr() As Integer, result As Collection)
    Dim i As Integer, key As String
    Dim newArr() As Integer
    
    If count = 0 Then
        If currentSum = target Then
            ' 排序后生成唯一标识，避免重复组合
            Call SortArray(tempArr)
            key = Join(tempArr, ",")
            On Error Resume Next
            result.Add key, key
            On Error GoTo 0
        End If
        Exit Sub
    End If
    
    ' 每个分队最多额外加3人，同时保证剩余分队能凑够目标总和
    For i = 0 To 3
        If currentSum + i + 3 * (count - 1) >= target And currentSum + i <= target Then
            ReDim newArr(UBound(tempArr) + 1)
            For j = 0 To UBound(tempArr)
                newArr(j) = tempArr(j)
            Next j
            newArr(UBound(newArr)) = i
            Call GenerateCombinations(target, count - 1, currentSum + i, newArr, result)
        End If
    Next i
End Sub

' 辅助函数：对数组进行升序排序
Sub SortArray(arr() As Integer)
    Dim i As Integer, j As Integer, temp As Integer
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) > arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
End Sub

使用说明 #

• 运行宏后，输入总队伍数和分队数量即可自动生成结果。
• 生成的组合会自动去重（仅保留无序唯一组合，比如不会同时出现(8,8,9,9,9)和(8,9,8,9,9)）。
• 若参数无效（比如总队伍数太少/太多），会弹出提示。

方法2：动态数组公式（仅适用于Excel 365/2021） #

适合熟悉Excel函数的用户，无需VBA，但分队数量较多时可能卡顿：

1. 定义名称：
   • 点击公式 → 定义名称，创建Divisions，引用分队数量单元格（如=$B$1）；创建TotalTeams，引用总队伍数单元格（如=$A$1）。
2. 在单元格D1输入以下公式：

=LET(
    minP,6,maxP,9,
    remain,TotalTeams-Divisions*minP,
    maxAdd,Divisions*(maxP-minP),
    IF(remain<0||remain>maxAdd,"无有效组合",
        LET(
            seq,SEQUENCE(Divisions),
            allCombs,MAKEARRAY(4^Divisions,Divisions,LAMBDA(r,c,MOD(INT((r-1)/4^(c-1)),4))),
            validCombs,FILTER(allCombs,BYROW(allCombs,LAMBDA(x,SUM(x)=remain))),
            sortedCombs,BYROW(validCombs,LAMBDA(x,SORT(x))),
            uniqueCombs,UNIQUE(sortedCombs),
            finalCombs,BYROW(uniqueCombs,LAMBDA(x,minP+x)),
            "("&TEXTJOIN(",",TRUE,finalCombs)&")"
        )
    )
)

• 公式会自动生成所有符合条件的唯一组合，格式为括号包裹的字符串。

内容的提问来源于stack exchange，提问作者Nicholas Komma