Question

我遇到了一个问题，我使用了几个嵌套的while循环解决了这个问题。但不幸的是，这意味着它需要花费数小时才能运行，因为这样做会产生数百万次迭代。

我想知道是否有人可以提出更好的方法。我将以标准产品和盈利方式描述问题。我有5个不同的产品页面，每个产品页面包含100个产品及其成本和利润。我必须从一页购买2种产品，从其他页面购买3种产品。我需要找到最佳组合，以最大化利润为基础，花费10000（我也只能购买每种产品中的一种）。

我看到的代码如下所示，但由于这需要很长时间而且常常崩溃，因此没有实际用途。

Do While productOneCount <= totalNumberOfProductOne
productOneCost = Worksheets("Product One").Range("C" & productOneCount)
productOneProfit = Worksheets("Product One").Range("E" & productOneCount)
secondProductOneCount = productOneCount + 1
Do While secondProductOneCount <= totalNumberOfProductOne
    secondProductOneCost = Worksheets("Product One").Range("C" & secondProductOneCount)
    secondProductOneProfit = Worksheets("Product One").Range("E" & secondProductOneCount)
    thirdProductOneCount = secondProductOneCount + 1
    Do While thirdProductOneCount <= totalNumberOfProductOne
        thirdProductOneCost = Range("C" & Worksheets("Product One").thirdProductOneCount)
        thirdProductOneProfit = Range("E" & Worksheets("Product One").thirdProductOneCount)
        productTwoCount = 1
        Do While productTwoCount <= totalNumberOfProductTwo
            productTwoCost = Worksheets("Product Two").Range("C" & productTwoCount)
            productTwoProfit = Worksheets("Product Two").Range("E" & productTwoCount)
            secondProductTwoCount = productTwoCount + 1
            Do While secondProductTwoCount <= totalNumberOfProductTwo
                secondProductTwoCost = Range("C" & secondProductTwoCount)
                secondProductTwoProfit = Range("E" & secondProductTwoCount)
                thirdProductTwoCount = secondProductTwoCount + 1

                '    this goes on for all 5 different products

                totalCost = productOneCost + secondProductOneCost + thirdProductOneCost + productTwoCost + secondProductTwoCost + restOfProductCosts
                totalProfit = productOneProfit + secondProductOneProfit + thirdProductOneProfit + productTwoProfit + secondProductTwoProfit + restOfProductProfit

                If totalCost <= 10000 Then
                    If totalProfit > bestProfit Then
                        Worksheets("Buy").Range("A1") = Worksheets("Product One").Range("B" & productOneCount)
                        Worksheets("Buy").Range("A2") = Worksheets("Product One").Range("B" & secondProductOneCount)
                        Worksheets("Buy").Range("A3") = Worksheets("Product One").Range("B" & thirdProductOneCount)
                        Worksheets("Buy").Range("A4") = Worksheets("Product Two").Range("B" & productTwoCount)
                        Worksheets("Buy").Range("A5") = Worksheets("Product Two").Range("B" & secondProductTwoCount)

                        Worksheets("Buy").Range("B1") = totalCost
                        Worksheets("Buy").Range("B2") = totalProfit
                        bestProfit = totalProfit
                    End If
                End If



                secondProductTwoCount = secondProductTwoCount + 1
            Loop
            productTwoCount = productTwoCount + 1
        Loop
        thirdProductOneCount = thirdProductOneCount + 1
    Loop
    secondProductOneCount = secondProductOneCount + 1
Loop
productOneCount = productOneCount + 1
Loop

Answer 1

当你尝试改进像A.S.H这样的算法时。提到，您可以做的最简单的更改是最小化与范围的交互 - 将所有数据移动到内存中，如Charles建议的那样

这是为了说明你如何转换;如您在 this answer 中所看到的那样，它应该以指数方式提高效率（以 2.023 秒处理500 K个单元格作为阵列与 43.578 秒细胞）

Option Explicit

Public Sub x()

    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
    Dim arr1 As Variant, arr2 As Variant, arr3 As Variant, arr4 As Variant, arr5 As Variant

    Set ws1 = Worksheets("Product One")
    Set ws2 = Worksheets("Product Two")
    '...
    arr1 = ws1.Range("C" & fRow & ":C" & lRow & ",E" & fRow & ":E" & lRow)      'move from range to array
    arr2 = ws2.Range("C" & fRow & ":C" & lRow & ",E" & fRow & ":E" & lRow)
    '...

    Do While productOneCount <= totalNumberOfProductOne
        productOneCost = arr1(productOneCount, 1)
        productOneProfit = arr1(productOneCount, 2)
        secondProductOneCount = productOneCount + 1
        Do While secondProductOneCount <= totalNumberOfProductOne
            secondProductOneCost = arr1(secondProductOneCount, 1)
            secondProductOneProfit = arr1(secondProductOneCount, 2)
            thirdProductOneCount = secondProductOneCount + 1
            Do While thirdProductOneCount <= totalNumberOfProductOne
                thirdProductOneCost = arr1(thirdProductOneCount, 1)
                thirdProductOneProfit = arr1(thirdProductOneCount, 2)
                productTwoCount = 1
                Do While productTwoCount <= totalNumberOfProductTwo
                    productTwoCost = arr2(productTwoCount, 1)
                    productTwoProfit = arr2(productTwoCount, 2)
                    secondProductTwoCount = productTwoCount + 1
                    '...
                    Do While secondProductTwoCount <= totalNumberOfProductTwo
                        '    this goes on for all 5 different products
                        If totalCost <= 10000 Then
                            If totalProfit > bestProfit Then
                                arr(1, 1) = arr(productOneCount, 2)
                                arr(2, 1) = arr(secondProductOneCount, 2)
                                arr(3, 1) = arr(thirdProductOneCount, 2)
                                arr(4, 1) = arr(productTwoCount, 2)
                                arr(5, 1) = arr(thirdProductOneCount, 2)
                                arr(1, 2) = totalCost
                                arr(2, 2) = totalProfit
                                bestProfit = totalProfit
                            End If
                        End If
                        secondProductTwoCount = secondProductTwoCount + 1
                    Loop
                    productTwoCount = productTwoCount + 1
                Loop
                thirdProductOneCount = thirdProductOneCount + 1
            Loop
            secondProductOneCount = secondProductOneCount + 1
        Loop
        productOneCount = productOneCount + 1
    Loop
End Sub

显然这没有正确设置，你必须相应地调整它，但最后你只需要将一个数组放回到工作表上，非常有效，交换类似于

ws2.Range("C" & fRow & ":C" & lRow & ",E" & fRow & ":E" & lRow) = arr2

循环时excel VBA的替代方案

1 个答案: