替代excel VBA while循环

我有一个问题,我已经解决了使用几个嵌套的while循环。 但不幸的是,这意味着需要花费数小时才能完成,就像做了数百万次迭代一样。

我想知道是否有人可以提出一个更好的方法。 我将以标准产品和利润方式来描述问题。 我有5个不同的产品页面,每个页面包含100个产品的成本和利润。 我必须从一个页面购买两个产品,其他三个产品。 我需要find最佳利润最大化的基础上有10000的消费(我也可以只购买每个产品之一)组合。

代码我看起来像下面这样,但是因为这需要很长时间,并且经常崩溃excel它是没有实际用处的。

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 

当你尝试改进像ASH这样的algorithm时,你可以做的最简单的改变就是尽量减less与范围的交互 – 按照Charles的build议将所有的数据移动到内存中

这是为了说明你如何转换; 它应该以指数方式提高效率,正如你在这个答案中所看到的( 500K单元在2.023秒处理为arrays, 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