分段函数灵活轻巧的解决办法

makelot

以下分段函数来自诉讼费用交纳办法 https://www.gov.cn/zwgk/2006-12/29/content_483407.htm
财产案件根据诉讼请求的金额或者价额，按照下列比例分段累计交纳：
1.不超过1万元的，每件交纳50元；
2.超过1万元至10万元的部分，按照2.5％交纳；
3.超过10万元至20万元的部分，按照2％交纳；
4.超过20万元至50万元的部分，按照1.5％交纳；
5.超过50万元至100万元的部分，按照1％交纳；
6.超过100万元至200万元的部分，按照0.9％交纳；
7.超过200万元至500万元的部分，按照0.8％交纳；
8.超过500万元至1000万元的部分，按照0.7％交纳；
9.超过1000万元至2000万元的部分，按照0.6％交纳；
10.超过2000万元的部分，按照0.5％交纳。

以下是我的代码，但显然这样的代码有点“死板笨重”。坛内高手云集，能否给出“灵活轻巧”的解决办法？非常感谢！

1. Function LitigationCost#(AmountClaimed#)
   
2.     Dim x#, y#
   
3.     x = AmountClaimed / 10000
   
4.     Select Case x
   
5.         Case Is <= 0
   
6.             Exit Function
   
7.         Case Is <= 1
   
8.             y = 0.005
   
9.         Case 1 To 10
   
10.             y = 0.005 + (x - 1) * 0.025
    
11.         Case 10 To 20
    
12.             y = 0.005 + 0.225 + (x - 10) * 0.02
    
13.         Case 20 To 50
    
14.             y = 0.005 + 0.225 + 0.2 + (x - 20) * 0.015
    
15.         Case 50 To 100
    
16.             y = 0.005 + 0.225 + 0.2 + 0.45 + (x - 50) * 0.01
    
17.         Case 100 To 200
    
18.             y = 0.005 + 0.225 + 0.2 + 0.45 + 0.5 + (x - 100) * 0.009
    
19.         Case 200 To 500
    
20.             y = 0.005 + 0.225 + 0.2 + 0.45 + 0.5 + 0.9 + (x - 200) * 0.008
    
21.         Case 500 To 1000
    
22.             y = 0.005 + 0.225 + 0.2 + 0.45 + 0.5 + 0.9 + 2.4 + (x - 500) * 0.007
    
23.         Case 1000 To 2000
    
24.             y = 0.005 + 0.225 + 0.2 + 0.45 + 0.5 + 0.9 + 2.4 + 3.5 + (x - 1000) * 0.006
    
25.         Case Is > 2000
    
26.             y = 0.005 + 0.225 + 0.2 + 0.45 + 0.5 + 0.9 + 2.4 + 3.5 + 6 + (x - 2000) * 0.005
    
27.     End Select
    
28.     LitigationCost = Round(y * 10000, 2)
    
29. End Function

复制代码

cnmlgb9998

这种“超额累进”计算方式，与个税计算方式是一样的。

用text函数，错位相减。

makelot

cnmlgb9998 发表于 2024-4-26 15:05
这种“超额累进”计算方式，与个税计算方式是一样的。

用text函数，错位相减。

非常感谢！请问为什么要用Text函数，"[<0]!0" 格式代表什么意思？

cnmlgb9998

makelot 发表于 2024-4-26 15:37
非常感谢！请问为什么要用Text函数，"[

消除负数。你把这个公式，先看明白，你就懂了！

grf1973

好象可以用Vlookup的模糊匹配模式

grf1973

1. Function myCost(AmountClaimed#)
   
2.     v = 50   '每件50元必须交
   
3.     ar = [{1,2.5;10,2;20,1.5;50,1;100,0.9;200,0.8;500,0.7;1000,0.6;2000,0.5}]   '分段计费标准
   
4.     n = UBound(ar)
   
5.     x = AmountClaimed / 10000
   
6.     For i = 1 To n - 1
   
7.         If x >= ar(i, 1) Then
   
8.             y = IIf(x >= ar(i + 1, 1), ar(i + 1, 1), x)   '本段计费数额（如果x大于下一计费段，则本段全计费，否则本段部分计费）
   
9.             v = v + (y - ar(i, 1)) * ar(i, 2) / 100
   
10.         Else
    
11.             Exit For
    
12.         End If
    
13.     Next
    
14.     If x >= ar(n, 1) Then v = v + (x - ar(n, 1)) * ar(n, 2) / 100 '超过最大标准
    
15.     myCost = Round(v * 10000, 2)
    
16. End Function
    

复制代码

grf1973

这样如果后续计费标准有所调整的话，只要改一下v和ar即可。

yynrzwh

grf1973

楼主原来代码虽然逻辑很清晰，但一旦计费标准发生改变，代码改变量很大。

makelot

grf1973 发表于 2024-4-26 16:17

非常感谢！您的思路很好，但是结果不正确，麻烦您再完善一下，多谢！

1. Sub myCostTest()
   
2.     Debug.Print myCost(600000) '结果应为 9800
   
3.     For Each amount In Array(1, 10, 20, 50, 100, 200, 500, 1000, 2000)
   
4.         Debug.Print myCost(CDbl(amount) * 10000), '结果应为 50 2300 430 8800 13800 22800 46800 81800 141800
   
5.     Next amount
   
6. End Sub

复制代码