fazendo uma lista de combinações de PO que igualam X usando lista de números aleatórios

Question

Eu tenho uma planilha de excel que tem uma lista de pedidos com um valor de caixa associado a cada pedido. por exemplo:

3156922129  10
756941986   13
1356902364  15
3156892373  15
9156912182  17
3756902389  22

Não tenho a lista completa publicada, mas tem 42 exemplos do exemplo acima.

O que temos que fazer manualmente agora é verificar as quantidades de pedidos e obter combinações que somam tp 75. Esse é o número de caixas que podemos colocar em um palete. No final, acabamos com 26 skids com os PO's iguais ou próximos do objetivo de 75 pontos. Existe uma maneira de pegar essa lista e ter o Excel te dando o que as PO's equivalem ou se aproximam da meta desejada?

    

Answer 1

Com seus dados postados nas colunas A e B , executando esta macro curta:

Sub kombo()
    Dim N As Long, i As Long, nBits As Long
    Dim s As String, j As Long, zum As Long

    nBits = 6
    N = 2 ^ nBits - 1

    For i = 1 To N
        s = Application.WorksheetFunction.Dec2Bin(i, nBits)
        For j = 1 To nBits
            Cells(j, 3) = Mid(s, j, 1)
        Next j
        zum = Evaluate("SUMPRODUCT((B1:B6)*(C1:C6))")
        If zum = 75 Then Exit Sub
    Next i

End Sub

contará em binário de 1 a 63, escrevendo padrões de 0 e 1 na coluna C . Cada padrão representa um subconjunto de pedidos. Cada subconjunto é resumido. Quando a soma atinge 75 , o programa pára.

Esteéumcódigodedemonstraçãoescritoparaapenas6itens.Paramanipular42itens,ocódigoprecisasermodificadoparageraromaiorconjuntodepadrõesde42bitseasvariáveisdeloopmuitomaiores.

EDIT#1:

Atualizeiocódigo,mastestei-oapenascomitens12.Ocódigotorna-seMUITOlentoàmedidaqueositenssãoadicionados(amenosquevocêtenhasorte).OcódigousaumafunçãopostadaporRickRothsteinaqui:

MrExcel Post

Sub kombo_2()
    Dim n As Double, i As Double, nBits As Long
    Dim s As String, j As Long, zum As Long

    nBits = 12
    n = 2 ^ nBits - 1
    Range("C:C").ClearContents
    Application.ScreenUpdating = False
    For i = 1 To n
        s = DecToBin(i, nBits)
        For j = 1 To nBits
            Cells(j, 3) = Mid(s, nBits - j + 1, 1)
        Next j
        zum = Evaluate("SUMPRODUCT((B1:B100)*(C1:C100))")
        If zum = 75 Then Exit For
    Next i
    Application.ScreenUpdating = True
End Sub

'
' https://www.mrexcel.com/forum/excel-questions/578667-use-dec2bin-function-visual-basic-applications-edit-macro.html
'
 'The DecimalIn argument is limited to 79228162514264337593543950245
' (approximately 96-bits) - large numerical values must be entered
' as a String value to prevent conversion to scientific notation. Then
' optional NumberOfBits allows you to zero-fill the front of smaller
' values in order to return values up to a desired bit level.

Function DecToBin(ByVal DecimalIn As Variant, Optional NumberOfBits As Variant) As String
  DecToBin = ""
  DecimalIn = CDec(DecimalIn)
  Do While DecimalIn <> 0
    DecToBin = Trim$(Str$(DecimalIn - 2 * Int(DecimalIn / 2))) & DecToBin
    DecimalIn = Int(DecimalIn / 2)
  Loop
  If Not IsMissing(NumberOfBits) Then
    If Len(DecToBin) > NumberOfBits Then
      DecToBin = "Error - Number too large for bit size"
    Else
      DecToBin = Right$(String$(NumberOfBits, "0") & DecToBin, NumberOfBits)
    End If
  End If
End Function