冒泡排序(或类似)具有单变量和多变量标准的 Excel VBA:求解最低总和

冒泡排序(或类似)具有单变量和多变量标准的 Excel VBA:求解最低总和

长期潜水员第一次发帖。

我正在做一个 Excel 项目,以解决最佳(最低价值)供应商组合并实现全面标准覆盖。对于 95% 的情况来说,这个练习相当简单。

在其余 5% 的情况下,我需要考虑供应商可能涵盖多个标准的情况。

我理解当每个供应商都满足一个标准时使用冒泡排序,但当涉及到组合标准时,我就不知所措了。我在网上搜索过,但运气不佳。诚然,这可能是我的搜索术语不正确造成的。

例如数据可能如下所示:

示例数据

在这个例子中,正确的解决方案是测试 1(A)和测试 6(B、C、D)的总和,因为这实现了完全标准覆盖并返回最低值。

我并不是在寻找代码示例,而是寻找一些关于如何应对挑战的概念性指导。

任何指点都将非常感激。

答案1

强力解决方案的一个例子。在这种情况下,需要 343*3 = 108 个循环。30 个标准的数量对我来说似乎非常多。

Sub FindOpt()
    Dim A, B, C, D
    A = Array(1, 5, 7)
    B = Array(2, 5, 6, 8)
    C = Array(3, 6, 8)
    D = Array(4, 6, 7)
    Dim Totals
    ReDim Totals(1 To 8) As Double
    Totals(1) = 1.5: Totals(2) = 2.5: Totals(3) = 3.5: Totals(4) = 4.5
    Totals(5) = 2.25: Totals(6) = 7#: Totals(7) = 4.25: Totals(8) = 4.5
   
    Dim i As Long, j As Long, k As Long, m As Long
    Dim Res, MinTot As Double, Tot As Double, el, MinRes
    MinTot = 100#
    For i = 0 To UBound(A)
        For j = 0 To UBound(B)
            For k = 0 To UBound(C)
                For m = 0 To UBound(D)
                    Res = RemDup(A(i), B(j), C(k), D(m))
                    Tot = 0#
                    For Each el In Res
                        Tot = Tot + Totals(el)
                    Next el
                    If Tot < MinTot Then
                        MinTot = Tot
                        MinRes = Res
                    End If
    Next m, k, j, i
    MsgBox "The best combination" & vbLf & "Total cost " & MinTot & _
        vbLf & "Vendors: " & Join(MinRes, ", ")
End Sub

Private Function RemDup(ParamArray list())
    Dim coll As New Collection
    Dim i As Long
    For i = LBound(list) To UBound(list)
        On Error Resume Next
        coll.Add CStr(list(i)), CStr(list(i))
        On Error GoTo 0
    Next i
    Dim Res
    ReDim Res(1 To coll.Count) As String
    For i = 1 To coll.Count
        Res(i) = coll(i)
    Next i
    RemDup = Res
End Function

相关内容