小金额优先,分离出5000数据.求程序或公式

bosshome

zxsea_7426

2900357148 发表于 2022-12-16 16:14
代码应该可以再优化一下，测试没发现什么问题，楼主试一下看看

运行到这一句出现

bosshome

2900357148 发表于 2022-12-16 16:14
代码应该可以再优化一下，测试没发现什么问题，楼主试一下看看

大神,代码看看能不能优化,1块钱数量为1的时候,数量变成-3的, 看看下面的截图,麻烦大神了.

2900357148

我还没测试这种极端情况，哈哈，我看看哪里问题

2900357148

这次多试了几种，没发现啥问题，你再试试，记得表3自己拉个表一第二列减表二第二列的公式哈。

Option Explicit
Private DlbSurplusValue As Double
Private DlbTempSum As Double
Private IntFaceValueCnt%, IntNumber%
Private ArrInfo
Private StartIndex%

Sub 优先小金额凑5000块()
    Range("G5:G14").ClearContents
    ArrInfo = Range("A3").CurrentRegion
    StartIndex = LBound(ArrInfo, 1) + 2
    '初步判断哪些面值   的钱之和第一次超过5000
    Call 计算面值数量(5000)
    Cells(IntNumber + 2, 7) = ArrInfo(IntNumber, 2) - IntFaceValueCnt '单独计算目前使用最大面值的数量
    Do Until DlbSurplusValue = 0
        Call 计算面值数量(DlbSurplusValue)
    Loop
   
End Sub
Sub 计算面值数量(MaxValue As Double)
    Dim i%
    DlbTempSum = 0
    If MaxValue = 5000 Then
        For i = UBound(ArrInfo, 1) - 1 To LBound(ArrInfo, 1) + 2 Step -1
            If DlbTempSum < MaxValue Then
                DlbTempSum = DlbTempSum + ArrInfo(i, 1) * ArrInfo(i, 2)
                Cells(i + 2, 7).Value = ArrInfo(i, 2)
                IntNumber = i
            Else
                Exit For
            End If
        Next i
    Else
        For i = StartIndex To UBound(ArrInfo, 1) - 1
            
            IntFaceValueCnt = Split(MaxValue / ArrInfo(i, 1), ".")(0)
'            If StartIndex = 11 Then Stop
            If IntFaceValueCnt > 0 Then
                If IntFaceValueCnt < ArrInfo(i, 2) Then
                    Cells(i + 2, 7).Value = ArrInfo(i, 2) - IntFaceValueCnt: StartIndex = i: Exit For
                Else
                    Cells(i + 2, 7).Value = 0: StartIndex = i + 1: Exit For
                End If
            End If
        Next i
    End If
    If MaxValue = 5000 Then
        IntFaceValueCnt = Split((DlbTempSum - MaxValue) / ArrInfo(IntNumber, 1), ".")(0)
        DlbSurplusValue = DlbTempSum - MaxValue - IntFaceValueCnt * ArrInfo(IntNumber, 1)
    Else
        If IntFaceValueCnt <= ArrInfo(i, 2) Then
            DlbSurplusValue = MaxValue - IntFaceValueCnt * ArrInfo(i, 1)
        Else
            DlbSurplusValue = MaxValue - ArrInfo(i, 2) * ArrInfo(i, 1)
        End If
    End If
End Sub

wanao2008

bosshome 发表于 2022-12-16 17:30

你表1就种情况无解。

huanghai22

wanao2008 发表于 2022-12-16 19:18
你表1就种情况无解。

怎么会无解呢？这个不是解吗？

huanghai22

就是凑数的一种

bosshome

2900357148  2022-12-16 18:41
ζ3ме

Option Ex ...

, лл. ..