Question

我需要想出解决问题的最短路径。无论如何，我都不是程序员。我正在尝试在excel中做到这一点。我在这里已经阅读了此问题的其他几个实例，但是没有找到对我有帮助的答案。谁能为我提供可以在excel中实现的解决方案？

我有6个不同的垫片。我需要一种快速的方法来确定这些垫片的最佳组合（最少的垫片）以达到我的目标尺寸。如有必要，您可以使用多个每个垫片。

White (51mm)
Black (44mm)
Blue (38mm)
Green (32mm)
Purple (26mm)
Orange (13mm)

示例：

Target - 83mm
Optimal solution: White - 1; Green - 1
Excel Solver solution: Blue - 1; Green - 1; Orange - 1

Answer 1

如果所有间隔符大小只能为正，那么一种解决方案可能是从target向后工作，并继续减去间隔符大小的“所有组合”，直到您的减法得出0（这表明a解决方案）。

以下代码存在问题：

基本上是蛮力，没有情报。
空间复杂度高，因此当搜索空间超出系统限制时，可能会出现“内存不足”错误。在编写代码的同时，我认为我需要存储每次迭代的结果。但是现在我认为只需要存储当前迭代的结果和先前迭代的结果即可。
没有规范化，这意味着代码可以尝试target - white spacer size - black spacer size，然后再尝试target - black spacer size - white spacer size；即使两次尝试的结果都相同。（换句话说，代码尝试了很多不需要的组合。）
代码不会跳过先前迭代已产生一个值的组合，该值会使遍历当前路径进一步浪费时间（例如，如果先前迭代产生负数或小于最小间隔大小的数字）。如果间隔物的大小永远不能为负（我认为这是对的），则应该进行此优化。
没有周期性的DoEvents，因此，如果解决方案在搜索空间中更深/更深，则Excel可能会变得无响应。

您将需要在TryToSolve过程中更改工作表名称和单元格引用，但是代码本身是：

Option Explicit

Private Function ConvertRangeToArrayOfLongs(ByVal someRange As Range) As Long()
    Dim inputArray As Variant
    inputArray = someRange.Value

    Dim outputArray() As Long
    ReDim outputArray(1 To UBound(inputArray, 1))

    Dim arrayIndex As Long
    For arrayIndex = LBound(outputArray, 1) To UBound(outputArray, 1)
        outputArray(arrayIndex) = CLng(inputArray(arrayIndex, 1))
    Next arrayIndex

    ConvertRangeToArrayOfLongs = outputArray
End Function

Private Sub TryToSolve()
    ' Subroutine needs better name.

    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1") ' Mine was on Sheet1, change to whatever your sheet is called.

    Dim target As Long
    target = sourceSheet.Range("A3") ' Mine was in cell A3, change to wherever yours is

    Dim spacerSizesRange As Range
    Set spacerSizesRange = sourceSheet.Range("D3:D8") ' Mine were in this range. Change to wherever yours are

    Dim spacerSizes() As Long
    spacerSizes = ConvertRangeToArrayOfLongs(spacerSizesRange)

    Dim spacerQuantities() As Long
    spacerQuantities = GetMinimumSpacerQuantities(target:=target, spacerSizes:=spacerSizes)

    spacerSizesRange.Offset(0, 1).Value = Application.Transpose(spacerQuantities) ' TRANSPOSE can only handle ~65k

End Sub

Private Function GetMinimumSpacerQuantities(ByVal target As Long, ByRef spacerSizes() As Long) As Long()
    ' This function needs a better name.

    Dim countOfSpacers As Long
    countOfSpacers = UBound(spacerSizes) ' Assumed to be 1-based

    Dim iterationLimit As Long ' Assuming no negative spacer sizes, solution must exist within this search space.
    iterationLimit = Application.RoundDown(target / Application.Min(spacerSizes), 0)

    Dim subtractionResults As Collection
    Set subtractionResults = New Collection

    Dim iterationIndex As Long
    For iterationIndex = 1 To iterationLimit

        Dim arrayToSubtract() As Long
        If iterationIndex > 1 Then
            arrayToSubtract = subtractionResults(iterationIndex - 1)
        Else
            arrayToSubtract = GetInitialisedNumericArray(lengthOfArray:=1, valueToInitialiseWith:=target)
        End If

        Const FLAG_VALUE As Long = -1

        Dim currentResults() As Long
        currentResults = GetInitialisedNumericArray(lengthOfArray:=countOfSpacers ^ iterationIndex, valueToInitialiseWith:=FLAG_VALUE)

        Dim writeIndex As Long
        writeIndex = 0 ' Needs resetting each iteration, otherwise index will be incorrect or out of bounds

        Dim subtractionIndex As Long
        For subtractionIndex = LBound(arrayToSubtract) To UBound(arrayToSubtract)
            Dim spacerIndex As Long
            For spacerIndex = 1 To countOfSpacers
                writeIndex = writeIndex + 1
                currentResults(writeIndex) = arrayToSubtract(subtractionIndex) - spacerSizes(spacerIndex)

                If currentResults(writeIndex) = 0 Then
                    GetMinimumSpacerQuantities = TranslateLoopStateToSpacerIndexes(writeIndex:=writeIndex, iterationIndex:=iterationIndex, countOfSpacers:=countOfSpacers)
                    Exit Function
                End If
            Next spacerIndex
        Next subtractionIndex

        subtractionResults.Add Item:=currentResults
    Next iterationIndex

    ' Raise error here? MsgBox?
    ' Return empty array?
    ' Don't know. Seems like no solution exists within search space.
    ' Handle however you like.


    MsgBox "No solution found within the search space." & vbNewLine & vbNewLine & " (If implementation is correct, then there is no combination of current spacer sizes which can produce the current target value.)"
    End
End Function

Private Function TranslateLoopStateToSpacerIndexes(ByVal writeIndex As Long, ByVal iterationIndex As Long, ByVal countOfSpacers As Long) As Long()
    ' If you have the "writeIndex" for a particular iteration,
    ' you can figure out which spacer index (and therefore which
    ' spacer) the "writeIndex" represents via modular arithmetic.
    '
    ' Given the current iteration's "writeIndex", to figure out
    ' the previous iteration's "writeIndex":
    '       ROUNDUP( currentWriteIndex / countOfSpacers )
    '
    ' Do the above in a loop (with iterationIndex declining) and keep track of
    ' each spacerIndex encountered.

    Dim calculatedWriteIndex As Long
    calculatedWriteIndex = writeIndex ' Can't calculate first time around. We already know it.

    Dim outputArray() As Long
    ReDim outputArray(1 To countOfSpacers)

    Dim i As Long ' Needs better name, but also kind of irrelevant/unreferenced elsewhere.
    For i = iterationIndex To 1 Step -1
        Dim calculatedSpacerIndex As Long
        calculatedSpacerIndex = ((calculatedWriteIndex - 1) Mod countOfSpacers) + 1 ' -1 + 1 to return a 1-based index

        outputArray(calculatedSpacerIndex) = outputArray(calculatedSpacerIndex) + 1

        calculatedWriteIndex = Application.RoundUp(calculatedWriteIndex / countOfSpacers, 0)
    Next i

    TranslateLoopStateToSpacerIndexes = outputArray

End Function

Private Function GetInitialisedNumericArray(ByVal lengthOfArray As Long, ByVal valueToInitialiseWith As Long) As Long()
    ' lengthOfArray is expected to be 1-based.
    ' I chose Long as return type since spacer sizes in example only seem to include whole numbers.

    Dim outputArray() As Long
    ReDim outputArray(1 To lengthOfArray)

    Dim index As Long
    For index = LBound(outputArray) To UBound(outputArray)
        outputArray(index) = valueToInitialiseWith
    Next index

    GetInitialisedNumericArray = outputArray
End Function

对于您的问题中发布的示例，我认为代码应该可以正常工作。但是，如果实际数据要大得多，请注意，此代码无法很好地扩展。另外，在以下情况下，您更有可能遇到内存问题：

间隔物数量增加
target与最小间隔尺寸之间的比率增加

因为这些因素也决定了搜索空间的大小。

小GIF显示正在尝试的目标（包括问题和评论中提到的目标），发现的第一个解决方案已写入黄色单元格中

达到给定总数的最短组合路径

1 个答案: