分享一个完美解决四舍六入五留双的东东

三流高手

海上钢琴师 发表于 2012-6-9 15:51
楼主好，如果本来是一位小数想要修约成整数该怎么办？貌似这个自定义函数办不到，例如18.5应修约成18

感谢楼主发现bug，现已经更正，请楼主再验证。

sunya_0529

楼主验证一下下面两个数，都修约到2位小数：
1.035
1234.975

三流高手

sunya_0529 发表于 2012-8-6 19:57
楼主验证一下下面两个数，都修约到2位小数：
1.035
1234.975

高手啊，能不能帮俺改改代码呢？俺VBA只是初学水平，希望您出手，帮助俺完善这个代码，让大家都能分享，多谢了。

sunya_0529

谢谢你细心的测试。

第一个问题应该是由于浮点运算的差异造成的，浮点数的加减总是会带来一些奇怪的问题；第二个问题是整数运算取位的疏忽。下面的代码已更正，有兴趣再试试看——

1. Function XRound(number#, Optional digits% = 2)
   
2. Dim g%, h%, i%, j%, k#
   
3. If digits < 0 Then '位舍入，沿小数点向左
   
4.   k = 10 ^ (-digits) '标记舍入精度
   
5.   number = number / k '折算成分位舍入小数
   
6.   digits = 0 '分位舍入取整
   
7. Else '分位舍入，沿小数点向右
   
8.   k = 1
   
9. End If
   
10. '确定nuber是小数还是整数，并记录其整数位长度
    
11. g = IIf(InStr(number, ".") = 0, Len(CStr(number)) + 1, InStr(number, "."))
    
12. h = Val(Mid(number, g + digits - IIf(digits = 0, 1, 0), 1)) '获取digits分位数值
    
13. i = Val(Mid(number, g + digits + 1, 1)) '获取digits+1分位数值
    
14. j = 1 '初始化进位值
    
15. '四舍五留双
    
16. If i < 5 Or (i = 5 And CStr(number) = Left(number, g + digits + 1) And h Mod 2 = 0) Then j = 0
    
17. '返回四舍六入五留双的修约值
    
18. XRound = Val(Left(number * 10 ^ digits + j, g + digits - 1)) / 10 ^ digits * k
    
19. End Function

复制代码

三流高手

sunya_0529 发表于 2012-8-6 19:57
楼主验证一下下面两个数，都修约到2位小数：
1.035
1234.975

代码已更正，谢谢楼主帮忙找bug。

sunya_0529

三流高手 发表于 2012-8-7 12:14
代码已更正，谢谢楼主帮忙找bug。

试了一下楼主更新后的代码，手头上的数据测试无误。

发一个我写的，借鉴了你的字符串判断的思路，不过支持逆向修约，即第二参数为负时，沿小数点向左的方向四舍六入五留双。

代码如下，供参考了——

1. Function XRound(number#, Optional digits% = 2)
   
2. Dim g%, h%, i%, j%, k#
   
3. If digits < 0 Then '位舍，沿小数点向左
   
4.   k = 10 ^ (-digits) '标记舍入精度
   
5.   number = number / k '折算成分位舍小数
   
6.   digits = 0 '分位舍取整
   
7. Else '分位舍，沿小数点向右
   
8.   k = 1
   
9. End If
   
10. '确定nuber是小数还是整数，并记录其整数位长度
    
11. g = IIf(InStr(number, ".") = 0, Len(number), InStr(number, "."))
    
12. h = Val(Mid(number, g + digits, 1)) '获取digits分位数值
    
13. i = Val(Mid(number, g + digits + 1, 1)) '获取digits+1分位数值
    
14. j = 1 '初始化进位值
    
15. '四舍五留双
    
16. If i < 5 Or (i = 5 And number - Round(number, digits + 1) = 0 And h Mod 2 = 0) Then j = 0
    
17. '返回四舍六入五留双的修约值
    
18. XRound = Val(Left(number * 10 ^ digits + j, g + digits - 1)) / 10 ^ digits * k
    
19. End Function

复制代码

三流高手

sunya_0529 发表于 2012-8-7 12:25
试了一下楼主更新后的代码，手头上的数据测试无误。

发一个我写的，借鉴了你的字符串判断的思路，不过 ...

俺也测试了一下您的代码，发现两个Bug：
8.65和2.2求和后修约到小数点后1位，对求和后的单元格进行引用（如：=xround（a3，1），结果为10.9（正确的应为10.8）
另：=Xround（5555555555，0），结果为5555555。

baoying19891207

sunya_0529 发表于 2012-8-7 14:51
谢谢你细心的测试。

第一个问题应该是由于浮点运算的差异造成的，浮点数的加减总是会带来一些奇怪的问题 ...

发现一个bug  测试0.805时显示数据0.81，实际使用过程中为0.80

coverne

搜玩美确实有好东西

wanghx8866

谢谢老师分享