替代Excel的VBA，而循環

我有一個問題，我已經解決了使用幾個嵌套的while循環。但不幸的是，這意味着需要花費數小時才能完成，因爲這樣做會造成數百萬次的迭代。替代Excel的VBA，而循環

我想知道是否有人可以提出更好的方法。我會用標準的產品和利潤方式來描述問題。我有5個不同的產品頁面，每個頁面都包含100個產品，其成本和利潤都將在這些產品上進行。我必須從一頁購買兩種產品，另一種購買三種產品。我需要找到最好的組合來最大化利潤的基礎上有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

來源

2015-09-24 Hammer

1.你看過使用Solver嗎？ –

2.讓您的數據到陣列和這些工作，而不是如果你的數據是巨大的循環中直接引用細胞 –

@hammer，問題是算法的性質，被稱爲對揹包問題。這是一個很難的問題，但你可能不得不尋找有效的算法。這並不是說你的Excel代碼不能進一步加速，比如在Charle的建議中。 –

雖然您嘗試改進算法，如A.S.H.提到的，你可以做最簡單的變化是儘量減少與範圍內的相互作用 - 所有的數據移動到存儲查爾斯建議

這是爲了說明如何可以轉換;它應該提高效率指數地可以在this answer看到（在2.023秒作爲陣列處理500個K細胞VS 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

來源

2015-09-24 12:18:58

替代Excel的VBA，而循環

回答

相關問題