将负账户余额分配给正账户余额，以尽量减少剩余金额答案

【问题标题】：Distribute negative account balances to positive account balances to minimize the amount left over将负账户余额分配给正账户余额，以尽量减少剩余金额
【发布时间】：2021-05-06 18:34:42
【问题描述】：

使用 excel，我在 A 列中有一个帐户列表（称它们为帐户 1、帐户 2、帐户 3 等）。在 B 列中，我有每个单独帐户的帐户余额，范围从 -10.00 到 10.00。

为了清楚起见：

Col A        Col B
Account 1    -5.15
Account 2     3.94
Account 3     9.13
Account 4    -0.33
Account 5     8.04
etc.

我正在处理数百个帐户。

我想做的是找出最有效的方法来将每个帐户平衡为零。并通过将负余额分配给正余额来做到这一点。无论是多个负余额账户被合并为一个余额为正的账户，还是一个负账户平衡多个正账户。我的目标是让每个账户平衡为零后剩余的价值尽可能接近零。

最后，在 col C 中，我希望每行中的单元格标出要从哪个帐户中提取，以将 col A 中的帐户平衡为零。在 col D 中，我希望每行中的单元格从 col C 中的帐户中调出所需的值，以分配给 col A 中的帐户。

我不确定这是否可以使用公式或使用 VBA 来完成。每一个解决方案都非常受欢迎。

谢谢。

【问题讨论】：

您好，欢迎来到 Stack Overflow。这不是免费的代码编写服务，但我们很乐意帮助您解决代码中的问题。到目前为止，您尝试过什么？
感谢您与我们联系。我不知道从哪里开始。我做了很多研究，希望能找到类似的问题。但是，我似乎找不到任何东西。我对完成我所追求的事情所需的逻辑不够熟悉。
听起来像公式可以做（大部分）你需要的一切。在 A 列和 B 列中创建一个包含 10 到 20 行数据（账户和余额）的小样本。然后具体写下您将如何计算每个数据的余额以及将余额归零的逻辑。这篇论文练习将在您自己的脑海中真正阐明您需要采取的确切步骤。你有这个想法，但你需要创建确切的步骤。完成后，请尝试一些公式和/或返回并提出更具体的问题并显示您的示例数据，以便我们提供帮助。
将所有帐户相加，除以帐户总数，然后将每个帐户设置为该值作为“目标”？从较大的帐户中减去“多余”并分配给需要资金的帐户？
感谢您的所有帮助。彼得，我想做的是，1）找到范围内的最高正值（C3：C150）。 2) 通过从具有负值的帐户分配数量来将其平衡为零。 3）在相邻的列中，显示要从哪些帐户中提取，以及从它们中提取多少。 4）找到下一个最高的正值。 5) 重复步骤 2) - 3)。

标签： excel vba excel-formula logic

【解决方案1】：

没有太多数据可以测试，但试试这个。它首先按 B 列对 Sheet1 上的数据进行排序。贷方和匹配的借方出现在 Sheet2 上。它只尝试匹配单个值，因此不会选择两个较小的值，因为它们可能比一个较大的值更好地匹配。

Option Explicit
Sub AccountMatch()
    
    Dim iLastRow As Long, i As Long, j As Long, iRow As Long
    Dim credit As Currency, debit As Currency

    iLastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To iLastRow
        Sheet1.Cells(i, 3) = i
    Next

    ' results sheet
    Sheet2.Cells.Clear
    iRow = 1
   
    ' sort values
    With Sheet1.Sort
         With .SortFields
            .Clear
            .Add Key:=Range("B2:B" & iLastRow), SortOn:=xlSortOnValues, _
                 Order:=xlDescending, DataOption:=xlSortNormal
         End With
        .SetRange Range("A1:C" & iLastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' match credit to debits
    i = 2
    credit = Sheet1.Cells(i, "B")
    Do While credit > 0
        iRow = iRow + 1
        Sheet2.Cells(iRow, 1) = Sheet1.Cells(i, 1)
        Sheet2.Cells(iRow, 2) = credit

        ' match negative moving upwards
        For j = iLastRow To 1 Step -1
            If Sheet1.Cells(j, 4) = "" Then
                debit = Sheet1.Cells(j, "B")
                If debit > 0 Then Exit For
                If credit + debit > 0 Then
                    Sheet2.Cells(iRow, 3) = Sheet1.Cells(j, 1)
                    Sheet2.Cells(iRow, 4) = debit
                    iRow = iRow + 1
                    'mark as matched
                    Sheet1.Cells(j, 4) = Sheet1.Cells(i, 1)
                    credit = credit + debit
                 End If
             End If
        Next
        Sheet2.Cells(iRow, 3) = "Remaining"
        Sheet2.Cells(iRow, 4) = credit

        ' next largest credit
        i = i + 1
        credit = Sheet1.Cells(i, "B")
    Loop

    MsgBox "Done"

End Sub

【讨论】：