在Excel VBA中切割算法，以最大限度地减少订购材料时的浪费

Question

我正在开发一个Excel电子表格，以尽量减少订购电缆时的浪费。我目前在excel VBA工作。电缆详细信息如下图所示，其中电缆ID是唯一ID。

电缆详细信息截图

对于每个即将到来的月份，我需要生成一份订单（如下所示）发送给供应商。所附示例尚未优化，您可以看到有很多浪费。

示例订单表格截图，未优化的电缆鼓

我需要创建一个匹配的算法： 电缆类型，电缆尺寸和电缆交货日期和优化电缆（电路）长度，适合每个鼓（通常500米长度）。

例如，我有5根电缆具有与上述相同的3个标准，但它们的长度分别为250,300,150,150,100。如果我的鼓尺寸是500米长的电缆，我不希望鼓1上250，鼓2上300 + 150和鼓3上150 + 100，因为总浪费为550米。如果我在鼓1上有250 + 150 + 100而在鼓2上有300 + 150，那么我只有50米的浪费。

我需要一种堆叠算法，可以搜索有线电视详细信息电子表格并测试所有可能的结果，以尽量减少订购浪费。

有多种电缆类型，每种电缆类型都有多种电缆尺寸。

订购按月完成。如果我们上个月剩余库存，我可以在以后考虑这个因素。

目前我的代码将循环通过电缆并在每个鼓上安装额外的电缆，但只按照它在列表中显示的顺序。请参阅下面的（杂乱）代码。

Sub Button3_Click()
Dim OrderDate As String, CableType As String, CableID As String, DrumID As String
Dim Item As Integer, CableLen As Integer, DrumSize As Integer, CableSize As Integer, OrderRow As Integer, DrumTest As Integer

'Store Order Date, Drum Size and beg. of Drum ID String
OrderDate = Cells(3, 16) & " " & Cells(4, 16)
DrumSize = Cells(5, 16)
DrumID = UCase(Left(Cells(3, 16), 3)) & "-" & Right(Cells(4, 16), 2) & "-" & "CD" & "-"
DrumNo = 1
OrderRow = 2
'Count how many cables in the table
NoCables = Application.CountA(Columns(1))

For a = 2 To NoCables
    'Loop through the cables to find a matching date
    If Cells(a, 9) = OrderDate Then
        For c = 2 To OrderRow
            'Check to see if Cable Type & Cable Size already in the order form
            If Cells(a, 4) = Worksheets("Order Form").Cells(c, 3) Then
                If Cells(a, 5) = Worksheets("Order Form").Cells(c, 4) Then
                    GoTo LoopExit
                End If
            End If
        Next c
        'Enter DrumID & first line of details
        CableType = Cells(a, 4)
        CableSize = Cells(a, 5)
        CableLen = Cells(a, 6)
        CableID = Cells(a, 2)
        Worksheets("Order Form").Cells(OrderRow, 1) = DrumID & DrumNo
        Worksheets("Order Form").Cells(OrderRow, 2) = CableID
        Worksheets("Order Form").Cells(OrderRow, 3) = CableType
        Worksheets("Order Form").Cells(OrderRow, 4) = CableSize
        Worksheets("Order Form").Cells(OrderRow, 5) = CableLen
        Worksheets("Order Form").Cells(OrderRow, 8) = CableLen
        DrumCurr = CableLen
        'Search through remaining cables to find cables that match the 3 criteria
        For b = a + 1 To NoCables
            If Cells(b, 9) = OrderDate Then
                If Cells(b, 4) = CableType Then
                    If Cells(b, 5) = CableSize Then
                        CableID = Cells(b, 2)
                        CableLen = Cells(b, 6)
                        DrumTest = DrumCurr + CableLen
                        'Test to see if cummulative cable len is larger than drum size
                        If DrumTest > DrumSize Then
                            'Start a new drum number if previous one exceeded
                            Worksheets("Order Form").Cells(OrderRow, 9) = DrumSize - DrumCurr
                            DrumNo = DrumNo + 1
                            OrderRow = OrderRow + 2
                            Worksheets("Order Form").Cells(OrderRow, 1) = DrumID & DrumNo
                            Worksheets("Order Form").Cells(OrderRow, 2) = CableID
                            Worksheets("Order Form").Cells(OrderRow, 3) = CableType
                            Worksheets("Order Form").Cells(OrderRow, 4) = CableSize
                            Worksheets("Order Form").Cells(OrderRow, 5) = CableLen
                            Worksheets("Order Form").Cells(OrderRow, 8) = CableLen
                            DrumCurr = CableLen
                        Else
                            'Add to the current drum
                            OrderRow = OrderRow + 1
                            DrumCurr = DrumTest
                            Worksheets("Order Form").Cells(OrderRow, 2) = CableID
                            Worksheets("Order Form").Cells(OrderRow, 3) = CableType
                            Worksheets("Order Form").Cells(OrderRow, 4) = CableSize
                            Worksheets("Order Form").Cells(OrderRow, 5) = CableLen
                            Worksheets("Order Form").Cells(OrderRow, 8) = DrumCurr
                            Worksheets("Order Form").Cells(OrderRow - 1, 8) = ""
                        End If
                    End If
                End If
            End If
        Next b
        'Start a new drum and state excess length
        DrumNo = DrumNo + 1
        Worksheets("Order Form").Cells(OrderRow, 9) = DrumSize - DrumCurr
        OrderRow = OrderRow + 2
    End If
LoopExit:
Next a

End Sub

我确信我可以使用工作表功能清理代码。然而，为了获得我需要的优化，我想我将需要添加到数组的电缆，并以某种方式选择组合等于500的那些。也许某种类型的冒泡排序，以获得更大的长度到列表的顶部？欢迎任何意见/想法。

Answer 1

如果我看到了这一点，那么您的问题可以转换为Activity selection problem，这意味着贪婪算法可以提供最佳值。

我不知道VBA，但这就是它在（伪）代码中看起来的样子（它实际上是JS。）

您将拥有{ id: 'LV01E', value: 120 }形式的对象，并在算法中发送这些形式的数组。

function optimize(objArr, maxSize) {
    let ret = [[]]
    let idx = 0

    while (objArr.length) {
        let sizeLeft = size - ret[idx].reduce((sum, obj) => sum + obj.value, 0)  // size of current bucket
        // find the biggest element that fits in sizeLeft
        let big = objArr.reduce((big, obj) => obj.value <= sizeLeft && big.value < obj.value ? obj : big, { value: Number.NEGATIVE_INFINITY })
        if (big.id) {
            // add the biggest element to the current array
            ret[idx] = [ ...ret[idx], big]
            // and remove it from the output
            objArr = objArr.filter(obj => obj.id !== big.id)
        } else {
            ret.push([])
            ++idx
        }
    }
    return ret
}

let r = optimizer([{ id: 1, value: 250 }, 
                   { id: 2, value: 100 },
                   { id: 3, value: 150 }, 
                   { id: 4, value: 150 }, 
                   { id: 5, value: 300 }], 500)

结果

[ [ { id: 5, value: 300 }, { id: 3, value: 150 } ],
  [ { id: 1, value: 250 }, { id: 4, value: 150 }, { id: 2, value: 100 } ] ]