Question

使用 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.

我正在处理数百个帐户。

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

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

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

谢谢。

Answer 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

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

1 个答案: