VBA气泡排序-不更改工作表。

Option Explicit

Sub calc75()

    Const PCENT = 0.75

    Dim rng, ar, ix, x As Long, z As Long, cutoff As Double
    Dim n As Long, i As Long, a As Long, b As Long
    Dim t As Double, msg As String, prev As Long, bFlag As Boolean
   
    ' company and amount
    Set rng = Sheet1.Range("A2:B11")
    ar = rng.Value2
    n = UBound(ar)
   
    ' calc cutoff
    ReDim ix(1 To n)
    For i = 1 To n
       ix(i) = i
       cutoff = cutoff + ar(i, 2) * PCENT
    Next

    ' bubble sort
    For a = 1 To n - 1
        For b = a + 1 To n
            ' compare col B
            If ar(ix(b), 2) > ar(ix(a), 2) Then
                z = ix(a)
                ix(a) = ix(b)
                ix(b) = z
            End If
        Next
    Next
   
    ' result
    x = 1
    For i = 1 To n
        t = t + ar(ix(i), 2)
        If t  > cutoff And Not bFlag Then
           msg = msg & vbLf & String(30, "-")
           bFlag = True
           If i > 1 Then x = i - 1
        End If
        
        msg = msg & vbLf & i & ") " & ar(ix(i), 1) _
             & Format(ar(ix(i), 2), "  0") _
             & Format(t, "  0")
   Next
   
   MsgBox msg, vbInformation, ar(x, 1) & " Cutoff=" & cutoff

End Sub

所以，按照我的建议简单地设置它。
您可以添加或更改约束条件，因为您希望得到您需要的结果-我选择二进制开始，但您可以限制为整数和1，2或3，例如。

我包括了我使用的roundup（）以及sumproduct。
我使用二进制，因为它给出了一个明确的指示，选择，整数值也将做同样的事情。

运行总计的最小值...

=LET(Data,B2:B11,Ratio,0.75,
    Sorted,SORT(Data,,-1),MaxSum,SUM(Sorted)*Ratio,
    Scanned,SCAN(0,Sorted,LAMBDA(a,b,IF((a+b)<=MaxSum,a+b,0))),
    srIndex,XMATCH(0,Scanned)-1,
Result,INDEX(Sorted,srIndex),Result)

G2:  =SORT(B2:B11,,-1)
H2:  =SUM(B2:B11)*0.75
I2:  =SCAN(0,G2#,LAMBDA(a,b,IF((a+b)<$H$2,a+b,0)))
J2:  =XMATCH(0,I2#)
K2:  =INDEX(G2#,XMATCH(0,I2#)-1)

• 出现的问题是，Amount列中可能存在重复项，而无法确定哪个结果是正确的。
• 如果公司名称是唯一的，则准确的方法是返回公司名称。

=LET(rData,A2:A11,lData,B2:B11,Ratio,0.75,
    Data,HSTACK(rData,lData),Sorted,SORT(Data,2,-1),
    lSorted,TAKE(Sorted,,-1),MaxSum,SUM(lSorted)*Ratio,
    Scanned,SCAN(0,lSorted,LAMBDA(a,b,IF((a+b)<=MaxSum,a+b,0))),
    rSorted,TAKE(Sorted,,1),rIndex,XMATCH(0,Scanned)-1,
Result,INDEX(rSorted,rIndex),Result)

• 请注意，您可以使用公式LAMBDA版本的以下部分定义名称，例如GetCutOffCompany：

=LAMBDA(rData,lData,Ratio,LET(
    Data,HSTACK(rData,lData),Sorted,SORT(Data,2,-1),
    lSorted,TAKE(Sorted,,-1),MaxSum,SUM(lSorted)*Ratio,
    Scanned,SCAN(0,lSorted,LAMBDA(a,b,IF((a+b)<=MaxSum,a+b,0))),
    rSorted,TAKE(Sorted,,1),rIndex,XMATCH(0,Scanned)-1,
Result,INDEX(rSorted,rIndex),Result))

• 然后，您可以在工作簿中的任何位置使用该名称，就像使用任何其他Excel函数一样，例如：

=GetCutOffCompany(A2:A11,B2:B11,0.75)