Пакеты Best Fit - запрос VBA

Question

Я делаю вещи партиями по 15, 20, 26, 40.

    - If I need to fit 80 items in these batches,
 guess the best fit would be to use 2 of 40 (batches) or 4 of 20 batches..

Есть ли способ получить это в функции или формуле, чтобы получить лучшее соответствие, пожалуйста, динамически, чтобы я мог Пожалуйста, знайте, что лучше всего подходит ....

Answer 1

Проверьте этот код, пожалуйста. Значения пакетов будут в диапазоне «B1: E1». Только пакетные значения (15, 20, 26, 40). Если строка «Batch» должна существовать, ее можно добавить путем форматирования ячейки («Batch» ###). Он не возвращает все возможные варианты. Он пытается вернуть лучший матч с точки зрения минимального количества партий. Возможно, это можно улучшить, но мне это не нужно, мне было лень это делать, а также то, что ...

Поверх кода вашего модуля поставьте:

Option Explicit
Private boolOff As Boolean

И после этого:

Sub testBatchOptimization()
  Dim sh As Worksheet, arrB As Variant, chkb As Double

  Set sh = ActiveSheet
  arrB = sh.Range("B1:E1").Value
  chkb = sh.Range("B2").Value
  MsgBox recursiveBatch(arrB, chkb, 1)
End Sub
Function recursiveBatch(arrB As Variant, chkb As Double, levelX As Long) As String
    Dim nrB As Long, nrBOld As Long, i As Long, Rez As Long, boolF As Boolean
    For i = 1 To UBound(arrB, 2)
        Select Case levelX
            Case 1
                If chkb = arrB(1, i) Then
                    Rez = arrB(1, i): nrB = 1: boolF = True: Exit For
                ElseIf chkb Mod arrB(1, i) = 0 Then 'fix division
                    If nrBOld = 0 Then
                        nrB = chkb / arrB(1, i): _
                               Rez = arrB(1, i): boolF = True
                    Else
                        If nrBOld >= chkb / arrB(1, i) Then _
                              nrB = chkb / arrB(1, i): _
                              Rez = arrB(1, i): boolF = True
                    End If
                    nrBOld = chkb / arrB(1, i)
                End If
            Case 2
                If i = UBound(arrB, 2) And chkb > arrB(1, UBound(arrB, 2)) + _
                    arrB(1, UBound(arrB, 2) - 1) Then recursiveBatch = recursiveBatch(arrB, chkb, 3)
                     If boolOff Then boolOff = False: Exit Function
                If arrB(1, i) >= chkb Then
                    recursiveBatch = "one batch of " & arrB(1, i)
                    Exit Function
                ElseIf arrB(1, i) < chkb And arrB(1, i + 1) And i < UBound(arrB, 2) >= chkb Then
                    recursiveBatch = "one batch of " & arrB(1, i + 1)
                    Exit Function
                ElseIf arrB(1, i) + arrB(1, i + 1) >= chkb And chkb > arrB(1, UBound(arrB, 2)) Then
                    If i = 3 And arrB(1, i + 1) + arrB(1, 1) >= chkb Then
                        recursiveBatch = "1 batch of " & arrB(1, 1) & " plus 1 batch of " & arrB(1, i + 1)
                        Exit Function
                    ElseIf i = 3 And arrB(1, i + 1) + arrB(1, 2) >= chkb Then
                        recursiveBatch = "1 batch of " & arrB(1, 2) & " plus 1 batch of " & arrB(1, i + 1)
                        Exit Function
                    Else
                        recursiveBatch = "1 batch of " & arrB(1, i) & " plus 1 batch of " & arrB(1, i + 1)
                        Exit Function
                    End If
                End If
            Case 3
                If chkb < arrB(1, 1) + arrB(1, 2) + arrB(1, 3) + arrB(1, 3) Then
                    If arrB(1, 4) + arrB(1, 3) + arrB(1, i) >= chkb Then
                        recursiveBatch = "1 batch of " & arrB(1, i) & " plus 1 batch of " & arrB(1, 3) & _
                                        " plus 1 batch of " & arrB(1, 4)
                        boolOff = True: Exit Function
                    End If
                Else
                   recursiveBatch = interpretCase(Rez, nrB, chkb)
                    boolOff = True: Exit Function
                End If
        End Select
    Next i
    If boolF Then
        If Rez = 20 Or Rez = 26 Then
            If nrB > 2 Then
                recursiveBatch = interpretCase(Rez, nrB, chkb)
                boolOff = True: Exit Function
            Else
                recursiveBatch = nrB & " batches of " & Rez
            End If
            Exit Function
        ElseIf Rez = 15 Then
            If nrB > 3 Then
                recursiveBatch = interpretCase(Rez, nrB, chkb)
                boolOff = True: Exit Function
            Else
                recursiveBatch = nrB & " batches of " & Rez
            End If
            Exit Function
        End If

    Else
        recursiveBatch = recursiveBatch(arrB, chkb, 2)
    End If
End Function
Private Function interpretCase(Rez As Long, nrB As Long, ByVal chkb As Long) As String
    Dim nr40 As Long, nr26 As Long, nr20 As Long, nr15 As Long, rest As Long
    nr40 = Int(chkb / 40)
    rest = chkb - (nr40 * 40)
    If rest <= 15 Then
        interpretCase = nr40 & IIf(nr40 = 1, " batch ", " batches ") & "of 40 and 1 batch of 15"
    ElseIf rest <= 20 Then
        interpretCase = nr40 & IIf(nr40 = 1, " batch ", " batches ") & "of 40 and 1 batch of 20"
    ElseIf rest <= 26 Then
        interpretCase = nr40 & IIf(nr40 = 1, " batch ", " batches ") & "of 40 and 1 batch of 26"
    Else
        interpretCase = nr40 + 1 & " batches of 40"
    End If
End Function

Я тестировал его ограниченное количество раз и значений. Я не обнаружил никакой ошибки, но могут возникнуть проблемы, когда он не был точно проверен, как следует ...

Я думаю, что это легко понять. Я попробовал некоторые комментарии, но он стал густым.

Answer 2

Вы можете попробовать это:

Структура листа:

Код:

Sub test()

    Dim rngBatches As Range, cell As Range
    Dim No_Items As Long
    Dim strResults As String

    With ThisWorkbook.Worksheets("Sheet1")

        Set rngBatches = .Range("B1:E1")
        No_Items = .Range("B2").Value

        For Each cell In rngBatches

            If No_Items / cell = Int(No_Items / cell) Then
                If strResults = "" Then
                    strResults = "Option(s):" & vbNewLine & No_Items / cell & " batches of " & cell & " items."
                Else
                    strResults = strResults & vbNewLine & No_Items / cell & " batches of " & cell & " items."
                End If
            End If
        Next cell

        MsgBox strResults

    End With

End Sub