求VBA实现最优分组：将1-33数值组合为不超33的最少集合

现有一组数量可变、取值范围1-33的数值（对应卡车托盘数量），需要编写VBA代码实现最优分组逻辑：

• 选取指定数值区域
• 将数值组合为总和不超过33的集合
• 要求集合数量最少
• 每个集合存入独立数组

当前仅能按顺序分组，效率极低：

• 示例1：数值列表10、15、8、22、19，最优分组为3个集合（总和25、30、19）
• 示例2：数值顺序变为19、22、15、10、8，按顺序分组得到4个集合（总和19、22、15、18），远非最优解

已编写测试代码如下，寻求最优组合逻辑的VBA方案：

Sub test()
Dim ref, b As Range
Dim volume, i As Integer
Dim test1(), check, total As Double
Dim c As Long

Set ref = Selection
volume = ref.Cells.Count
c = ref.Column
ReDim test1(1 To volume)

'this creates a total of all the values i select
For Each b In ref
    total = total + b
Next b

'this determines when to round up or down
check = total / 33 - Application.WorksheetFunction.RoundDown(total / 33, 0)
If check < 0.6 Then
    total = Application.WorksheetFunction.RoundDown(total / 33, 0)
Else
    total = Application.WorksheetFunction.RoundUp(total / 33, 0)
End If

'this creates an array with all the values
i = 1
Do Until i = volume + 1
    test1(i) = Cells(i, c).Value
    i = i + 1
Loop

'this is just a way for me to check and verify my current part of the code
MsgBox (Round(test1(8), 2))
MsgBox (total)

End Sub

这个问题属于一维装箱问题，最优解是NP-hard问题，实际场景中可以用**贪心算法（首次递减适配）**来近似最优解，能满足需求且效率较高。

核心逻辑 #

1. 将所有数值按从大到小排序
2. 依次将每个数值放入第一个能容纳它的集合（总和+当前数值≤33）
3. 如果没有能容纳的集合，新建一个集合

完整VBA代码 #

Sub OptimalPalletGrouping()
    Dim selectedRange As Range
    Dim valuesArr() As Variant
    Dim sortedArr() As Variant
    Dim groups As Collection
    Dim groupSumArr() As Integer
    Dim i As Integer, j As Integer
    Dim currentVal As Integer
    Dim added As Boolean
    
    ' 获取选中区域
    Set selectedRange = Selection
    If selectedRange.Cells.Count = 0 Then
        MsgBox "请先选择包含数值的区域！", vbExclamation
        Exit Sub
    End If
    
    ' 将选中区域的值存入数组
    valuesArr = selectedRange.Value
    ReDim sortedArr(1 To UBound(valuesArr, 1) * UBound(valuesArr, 2))
    i = 1
    For Each cell In selectedRange
        sortedArr(i) = cell.Value
        ' 验证数值范围
        If sortedArr(i) < 1 Or sortedArr(i) > 33 Then
            MsgBox "数值必须在1-33之间！", vbCritical
            Exit Sub
        End If
        i = i + 1
    Next cell
    ReDim Preserve sortedArr(1 To i - 1)
    
    ' 数组从大到小排序
    BubbleSortDescending sortedArr
    
    ' 初始化分组集合和总和数组
    Set groups = New Collection
    ReDim groupSumArr(0)
    
    ' 遍历每个数值进行分组
    For i = 1 To UBound(sortedArr)
        currentVal = sortedArr(i)
        added = False
        
        ' 尝试放入已有的分组
        For j = 1 To groups.Count
            If groupSumArr(j - 1) + currentVal <= 33 Then
                groups(j).Add currentVal
                groupSumArr(j - 1) = groupSumArr(j - 1) + currentVal
                added = True
                Exit For
            End If
        Next j
        
        ' 无法放入已有分组，新建分组
        If Not added Then
            Dim newGroup As Collection
            Set newGroup = New Collection
            newGroup.Add currentVal
            groups.Add newGroup
            ReDim Preserve groupSumArr(0 To groups.Count - 1)
            groupSumArr(groups.Count - 1) = currentVal
        End If
    Next i
    
    ' 输出分组结果（可根据需求调整输出方式）
    Dim outputMsg As String
    outputMsg = "最优分组结果（共" & groups.Count & "组）：" & vbCrLf & vbCrLf
    For i = 1 To groups.Count
        outputMsg = outputMsg & "第" & i & "组："
        For j = 1 To groups(i).Count
            outputMsg = outputMsg & groups(i)(j) & " "
        Next j
        outputMsg = outputMsg & "| 总和：" & groupSumArr(i - 1) & vbCrLf
    Next i
    MsgBox outputMsg, vbInformation
    
    ' 将分组存入独立数组（按需使用）
    Dim groupArrays() As Variant
    ReDim groupArrays(1 To groups.Count)
    For i = 1 To groups.Count
        ReDim tempArr(1 To groups(i).Count)
        For j = 1 To groups(i).Count
            tempArr(j) = groups(i)(j)
        Next j
        groupArrays(i) = tempArr
    Next i
End Sub

' 辅助函数：冒泡排序（降序）
Sub BubbleSortDescending(arr() As Variant)
    Dim i As Integer, j As Integer
    Dim temp As Variant
    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

代码说明 #

• 排序步骤：先将数值从大到小排序，最大化每个集合的利用率，是贪心算法的核心
• 分组逻辑：逐个将数值放入第一个能容纳它的集合，避免空间浪费
• 验证机制：加入数值范围校验，防止非法输入
• 结果输出：通过MsgBox展示分组情况，同时支持将分组存入独立数组（groupArrays）
• 效率：时间复杂度为O(n²)，对于普通规模的托盘数量（几十到上百个）完全够用

测试示例 #

输入19、22、15、10、8，排序后为22、19、15、10、8，分组结果：

1. 22 + 8 = 30
2. 19 + 10 = 29
3. 15
   共3组，达到最优解

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