VBA - Backpack problem

As I mentioned in the comment, your problem is not exactly the problem of the backpack , because you are not looking for find an optimal solution (such as the minimum number of shopping carts to accommodate all products, for example). Yet you're right in the fact that your problem resembles combinatorial optimization problems.

I made a rather "innocent" attempt (in the sense that I did not bother with the performance of the algorithm) in the hope that it might help you. It was a good exercise for me to remember how VBA works. :)

The principle of the solution that I am proposing is the following:

• As with the tacky approach to solving the classic backpack problem, items are sorted in descending order of price. This helps in the sense that the more expensive items are eliminated quickly (in your example it should be noted that product F, which costs 950) does not "fit" into the maximum 1000 cart with no other product.)

  li>

• As you would like to have the various combinations of each product (x1, x2, x3, ..., etc), it is necessary to calculate what is the maximum of items of a product that would fit in the cart. You will notice in the algorithm that there is a loop ( For iQtd = 1 To iQtdMax ) just to handle those combinations.

• The implementation is inherently recursive (and here is my concern about complexity - more about it at the end), so that for every quantity of a product the algorithm looks for all possible combinations of the following products that they fit in the remaining price (remembering that the algorithm is based on the fact that the product list is ordered from the highest to the lowest price). For example, when the algorithm is treating product B (which can be placed in the cart at most%% of times%), it will make the combinations for the quantities of B from 1 to 4. Assuming that it is in the loop in which the quantity iQtd equals 3. This means that in the cart there will be the equivalent of 1000 / 250 = 4 , so there will only be 150 left to try to include the next smaller items (ie products C and A). Note that the value of this difference is passed in the recursive call of the 3 x 250 = 750 function.

• The Combine function treats the elements by directly using the Combine object of VBA, but you can change this to an array if you prefer. Also, your return is an array of strings with the combinations the same way you used in your question, merely as a form of illustration. You can modify it to return it in the way you think is most appropriate.

Here is the code I built as an example.

Option Base 1

' Macro chamada pelo botão na planilha "Dados".
' Apenas faz a mágica e cria uma nova planilha "Resultado" com as combinações.
Sub GenerateList()

On Error Resume Next

    Dim dMaxPrice As Double
    Dim oData As Range
    Dim aResp() As String
    Dim oSheet As Worksheet

    ' Ordena os dados em ordem descendente de preço
    Set oData = Range("A2:B7")
    oData.Sort key1:=Range("B2:B7"), Order1:=xlDescending

    ' Obtém o preço máximo
    dMaxPrice = CDbl(Cells(1, 5).Value)

    ' Monta a lista de combinações com os dados
    aResp = Combine(oData, dMaxPrice)

    Set oSheet = Worksheets("Resultado")
    If Err = 0 Then
        Application.DisplayAlerts = False
        oSheet.Delete
        Application.DisplayAlerts = True
    End If

    Set oSheet = ActiveWorkbook.Worksheets.Add(After:=Worksheets("Dados"))
    oSheet.Name = "Resultado"
    For i = 1 To UBound(aResp)
        oSheet.Cells(i, 1).Value = aResp(i)
    Next i
    oSheet.Columns(1).AutoFit
    oSheet.Activate

End Sub

' Esta é a função que propriamente faz as combinações
' Ela está meramente recursiva, então note que sua complexidade é exponencial com relação
' à quantidade de dados de entrada.
'
' Parâmetros:
' oData Objeto Worksheet.Range com os dados processados em cada chamada recursiva.
' dMaxPrice Valor (double) com o limite de preço restante no nível da chamada.
'
' Retorno:
' Retorna um array de strings com as combinações no formato "Produto A x? Produto B x? ..."
' como no exemplo da sua questão.
Function Combine(ByVal oData As Range, ByVal dMaxPrice) As Variant

On Error Resume Next

    Dim sProduct As String
    Dim dPrice As Double
    Dim iQtdMax As Integer
    Dim sRangeDef As String
    Dim oSubData As Range
    Dim aRet() As String
    Dim aCombReports() As String
    Dim iSize As Integer

    For iProd = 1 To oData.Rows.Count

        ' Nome e preço do produto atual
        sProduct = oData.Cells(iProd, 1)
        dPrice = oData.Cells(iProd, 2)

        ' Quantidade máxima de itens do produto atual, segundo seu preço e o limite máximo
        iQtdMax = Int(dMaxPrice / dPrice)

        ' Demais produtos no intervalo de dados além do produto atual
        If (iProd + 1 <= oData.Rows.Count) Then
            sRangeDef = "A" + CStr(iProd + 1) + ":B" + CStr(oData.Rows.Count)
            Set oSubData = oData.Range(sRangeDef)
        Else
            Set oSubData = Nothing
        End If

        ' Calcula todas as combinações de quantidades do produto atual,
        ' recursivamente incluindo as combinações dos demais produtos DE
        ' MENOR VALOR (devido ao fato do intervalo original de dados estar
        ' ordenado por preço em ordem descrescente)
        For iQtd = 1 To iQtdMax

            sReport = sProduct + " x" + CStr(iQtd) + " "
            dPriceRest = dMaxPrice - (iQtd * dPrice)

            ' Chamada recursiva indicando o preço máximo descontado o total de itens do produto inicial incluídos
            ' (Se, é claro, há preço sobrando para incluir mais produtos).
            If dPriceRest > 0 And Not oSubData Is Nothing Then
                aCombReports = Combine(oSubData, dPriceRest)
            Else
                Erase aCombReports
            End If

            ' Monta o retorno com as combinações obtidas para os demais produtos
            Err = 0
            iCombs = UBound(aCombReports)
            If Err = 0 Then
                Err = 0
                For Each sCombRep In aCombReports
                    Err = 0 ' <-------- LINHA ADICIONADA NA EDIÇÃO
                    iSize = UBound(aRet)
                    If Err <> 0 Then iSize = 0
                    ReDim Preserve aRet(iSize + 1)
                    aRet(iSize + 1) = sReport + sCombRep
                Next

            ' Se não retornou combinações, monta o retorno apenas com o produto atual
            Else
                Err = 0
                iSize = UBound(aRet)
                If Err <> 0 Then iSize = 0
                ReDim Preserve aRet(iSize + 1)
                aRet(iSize + 1) = sReport
            End If

        Next iQtd

    Next iProd

    ' Devolve o array de combinações
    Combine = aRet

End Function

Important notes:

The result that this code produces is this (total of 72 combinations):

Produto F x1 
Produto D x1 Produto C x1 
Produto D x1 Produto A x1 
Produto D x1 Produto A x2 
Produto E x1 Produto B x1 Produto A x1 
Produto E x1 Produto C x1 Produto A x1 
Produto E x1 Produto C x1 Produto A x2 
Produto E x1 Produto C x2 
Produto E x1 Produto A x1 
Produto E x1 Produto A x2 
Produto E x1 Produto A x3 
Produto E x1 Produto A x4 
Produto B x1 Produto C x1 Produto A x1 
Produto B x1 Produto C x1 Produto A x2 
Produto B x1 Produto C x1 Produto A x3 
Produto B x1 Produto C x1 Produto A x4 
Produto B x1 Produto C x1 Produto A x5 
Produto B x1 Produto C x2 Produto A x1 
Produto B x1 Produto C x2 Produto A x2 
Produto B x1 Produto C x2 Produto A x3 
Produto B x1 Produto C x3 Produto A x1 
Produto B x1 Produto A x1 
Produto B x1 Produto A x2 
Produto B x1 Produto A x3 
Produto B x1 Produto A x4 
Produto B x1 Produto A x5 
Produto B x1 Produto A x6 
Produto B x1 Produto A x7 
Produto B x2 Produto C x1 Produto A x1 
Produto B x2 Produto C x1 Produto A x2 
Produto B x2 Produto C x1 Produto A x3 
Produto B x2 Produto C x2 Produto A x1 
Produto B x2 Produto A x1 
Produto B x2 Produto A x2 
Produto B x2 Produto A x3 
Produto B x2 Produto A x4 
Produto B x2 Produto A x5 
Produto B x3 Produto C x1 
Produto B x3 Produto A x1 
Produto B x3 Produto A x2 
Produto B x4 
Produto C x1 Produto A x1 
Produto C x1 Produto A x2 
Produto C x1 Produto A x3 
Produto C x1 Produto A x4 
Produto C x1 Produto A x5 
Produto C x1 Produto A x6 
Produto C x1 Produto A x7 
Produto C x1 Produto A x8 
Produto C x2 Produto A x1 
Produto C x2 Produto A x2 
Produto C x2 Produto A x3 
Produto C x2 Produto A x4 
Produto C x2 Produto A x5 
Produto C x2 Produto A x6 
Produto C x3 Produto A x1 
Produto C x3 Produto A x2 
Produto C x3 Produto A x3 
Produto C x3 Produto A x4 
Produto C x4 Produto A x1 
Produto C x4 Produto A x2 
Produto C x5 
Produto A x1 
Produto A x2 
Produto A x3 
Produto A x4 
Produto A x5 
Produto A x6 
Produto A x7 
Produto A x8 
Produto A x9 
Produto A x10