统一的求近似数自定义函数：n舍m入

aoe1981 · 发表于 2019-12-14 22:12

本帖最后由 aoe1981 于 2019-12-15 11:22 编辑

写本帖是因为前帖：
请教四舍五入、五舍六入、四舍六入五成双的函数！
http://club.excelhome.net/thread-1089213-1-1.html
(出处: ExcelHome技术论坛)

粗糙且愚蠢。

今日发帖，略微深入，唯愿保证正确。

所谓“统一的求近似数自定义函数：n舍m入”，看名字也很多余，但我做的实际功能比名字上显示的多一些，主要有：
（一）n舍m入，m-n=1
具体有：
不舍0入：即“进一法"，实现结果上要与ROUNDUP()完全一致；
0舍1入；
1舍2入；
2舍3入；
3舍4入；
4舍5入；
5舍6入；
6舍7入；
7舍8入；
8舍9入；
9舍不入：即”去尾法"，实现结果上要与ROUNDDOWN()完全一致。
如图：
图1.jpg

（二）n舍m入n+1或m-1成双，m-n=2
具体有：
8舍9成双；
7舍9入8成双；
6舍8入7成双；
5舍7入6成双；
4舍6入5成双；
3舍5入4成双；
2舍4入3成双；
1舍3入2成双；
0舍2入1成双；
特殊地：“1入0成双”是不行的，因为保留位后的尾数全为0时，首选是等于原数。
如图：
图2.jpg

（三）n舍m入余扩展（扩展1位按4舍5入处理），m-n>2
不一而足，如：
3舍7入4、5、6按尾数部分第二位四舍五入扩展保留至尾数部分第一位；
……
如图：
图3.jpg

下面说说自定义函数本身：

代码如下：

Option Explicit
'成功版：最好用InStr(num & "", ".") = 0判断整数
'求近似数：n舍m入（精确数，近似位数，n舍，m入）
Public Function nSmR(num#, Optional ws% = 0, Optional n% = 4, Optional m% = 5)
Dim fh%, w0%, w1%, w2%
If n < -1 Or n > 9 Then nSmR = "n错误": Exit Function
If m < 0 Or m > 10 Then nSmR = "m错误": Exit Function
If n >= m Then nSmR = "n≥m": Exit Function
If num >= 0 Then fh = 1 Else fh = -1: num = Abs(num)
num = num * 10 ^ ws '第一次位移
w0 = Val(Right(Int(num), 1)) '保留位
If InStr(num & "", ".") = 0 Then
nSmR = fh * num * 10 ^ -ws
Else
num = num * 10 '第二次位移
w1 = Val(Right(Int(num), 1)) '尾数部分第一位
If w1 <= n Then
nSmR = Val(fh * Int(num / 10) * 10 ^ -ws)
ElseIf w1 >= m Then
nSmR = Val(fh * (Int(num / 10) + 1) * 10 ^ -ws)
Else
If m - n = 2 Then
If InStr(num & "", ".") = 0 Then
If w0 And 1 Then '奇入
nSmR = Val(fh * (Int(num / 10) + 1) * 10 ^ -ws)
Else '偶舍
nSmR = Val(fh * Int(num / 10) * 10 ^ -ws)
End If
Else
nSmR = Val(fh * (Int(num / 10) + 1) * 10 ^ -ws)
End If
Else
num = num * 10 '第三次位移
w2 = Val(Right(Int(num), 1)) '尾数部分第二位
If w2 <= 4 Then
nSmR = Val(fh * Int(num / 10) * 10 ^ -(ws + 1))
Else
nSmR = Val(fh * (Int(num / 10) + 1) * 10 ^ -(ws + 1))
End If
End If
End If
End If
End Function

复制代码

用法：
求近似数：nSmR（精确数num，近似位数ws，n舍，m入）
其中：
精确数num支持正数、负数；
近似位数ws正数表示小数部分第几位，0表示近似到个位，负数表示整数部分其他位，例如：2表示近似到百分位，0表示近似到个位，-2表示近似到百位；
如图：

图4.jpg

n的取值范围为：{-1,0,1,2,3,4,5,6,7,8,9}，m的取值范围为：{0,1,2,3,4,5,6,7,8,9,10}，且n<m；

n=-1，m=0时，相当于ROUNDUP()，如图（通过随机值连续按F9测试正确）：

图5.jpg

n=9，m=10时，相当于ROUNDDOWN()，如图（通过随机值连续按F9测试正确）：

图6.jpg

接下来是附件，包含完整测试过程。

求近似数：n舍m入.zip (35.66 KB, 下载次数: 16)

（增加了新的“误差测试”，详情见5楼。）

一些编写过程中的奇葩意外下楼再说。

aoe1981 · 发表于 2019-12-14 22:56

本帖最后由 aoe1981 于 2019-12-15 08:48 编辑

本楼首先补充一下“四舍六入五成双”的舍入规则，便于阅读理解。

以下摘自于百度百科并作出内容、格式调整：
“
　　“四舍六入五成双”，也即“4舍6入5凑偶”，具体有4条规则：
　　⑴尾数部分第一位≤4时直接舍去；
　　⑵尾数部分第一位≥6时进一舍去；
　　⑶尾数部分第一位＝5时，若尾数部分第二位及以后有非零数字时进一舍去；
　　⑷尾数部分第一位＝5时，若尾数部分第二位及以后无有效数字时，分两种情况：
　　　　①5前一位（保留位）为奇数，舍5入1；
　　　　②5前一位（保留位）为偶数，舍5不进（0是偶数）。

”

楼上拓展的如“七舍九入八成双”……，也遵循并类推上述四条规则。

在编写统一的n舍m入自定义函数时，遇到了一些奇葩的问题，甚是困惑，不明究竟。

瑕疵版：用num = Int(num)判断整数是不靠谱的；
成功版：最好用InStr(num & "", ".") = 0判断整数。

瑕疵版的代码对照如下：

Option Explicit
'瑕疵版：用num = Int(num)判断整数是不靠谱的
'求近似数：n舍m入（精确数，近似位数，n舍，m入）
Public Function nSmR1(num#, Optional ws% = 0, Optional n% = 4, Optional m% = 5)
Dim fh%, w0%, w1%, w2%
If n < -1 Or n > 9 Then nSmR1 = "n错误": Exit Function
If m < 0 Or m > 10 Then nSmR1 = "m错误": Exit Function
If n >= m Then nSmR1 = "n≥m": Exit Function
If num >= 0 Then fh = 1 Else fh = -1: num = Abs(num)
num = num * 10 ^ ws '第一次位移
w0 = Val(Right(Int(num), 1)) '保留位
If num = Int(num) Then
nSmR1 = fh * num / 10 ^ ws
Else
num = num * 10 '第二次位移
w1 = Val(Right(Int(num), 1)) '尾数部分第一位
If w1 <= n Then
nSmR1 = Val(fh * Int(num / 10) / 10 ^ ws)
ElseIf w1 >= m Then
nSmR1 = Val(fh * (Int(num / 10) + 1) / 10 ^ ws)
Else
If m - n = 2 Then
If num = Int(num) Then
If w0 And 1 Then '奇入
nSmR1 = Val(fh * (Int(num / 10) + 1) / 10 ^ ws)
Else '偶舍
nSmR1 = Val(fh * Int(num / 10) / 10 ^ ws)
End If
Else
nSmR1 = Val(fh * (Int(num / 10) + 1) / 10 ^ ws)
End If
Else
num = num * 10 '第三次位移
w2 = Val(Right(Int(num), 1)) '尾数部分第二位
If w2 <= 4 Then
nSmR1 = Val(fh * Int(num / 10) / 10 ^ (ws + 1))
Else
nSmR1 = Val(fh * (Int(num / 10) + 1) / 10 ^ (ws + 1))
End If
End If
End If
End If
End Function

复制代码

主要的区别是第12行、第23行，改：
If num = Int(num) Then
为：
If InStr(num & "", ".") = 0 Then

下面两图是使用瑕疵版nSmR1出错的图片：

图7.jpg

上图表现为：nSmR1(num,ws,-1,0)与ROUNDUP不一致；

图8.jpg

上图表现为：nSmR1(num,ws,9,10)与ROUNDDOWN不一致。

两种出错情况概率较小，要反复按F9才能刷出这个错误来。

出错原因就是用：
If num = Int(num) Then
判断整数时产生的。

图9.jpg

明明相等的，代码检测就是不相等，抓狂、迷惑……神经病！

yangyangzhifeng · 发表于 2019-12-14 23:07

aoe1981 发表于 2019-12-14 22:56
本楼首先补充一下“四舍六入五成双”的舍入规则，便于阅读理解。

以下摘自于百度百科并作出内容、格式调 ...

试试初始化位整数，过程中全部用整数处理，处理好后，输出时再变成小数

aoe1981 · 发表于 2019-12-15 08:58

本帖最后由 aoe1981 于 2019-12-15 09:01 编辑

yangyangzhifeng 发表于 2019-12-14 23:07
试试初始化位整数，过程中全部用整数处理，处理好后，输出时再变成小数

小数点位移过程涉及*10、/10、*100、/100、……等操作，会不会又转换为小数？

是不是当成字符串来操作？这样效率太低了……我笼统地不满意instr比int效率低，也希望自己的自定义函数中尽量少用其他现成的函数，但是依然用到了：int、right、val、abs。对于abs，和*(-1)转换也不清楚效率孰高孰低？

您的建议具体怎么操作呢？
另外，用w0 = Val(Right(Int(num), 1))是为了取个位数字，同样用int(num) mod 10也会出错，用字符串处理也是我的变通的办法。

aoe1981 · 发表于 2019-12-15 11:17

本帖最后由 aoe1981 于 2019-12-15 11:24 编辑

误差测试的图如下：

图10.jpg

使用的是我的自定义函数，各列公式如下：
B       =IF($O$1,INT(RAND()*10^$K$6)+INT(RAND()*10^$K$7)/10^$K$7,RAND()*100000)
C       =nsmr(B$1,IF($N$1=1,$K$3,$K$4),9,10)
D       =nsmr(B$1,IF($N$1=1,$K$3,$K$4),4,5)
E       =nsmr(B$1,IF($N$1=1,$K$3,$K$4),4,6)
F       =nsmr(B$1,IF($N$1=1,$K$3,$K$4),5,6)
G       =nsmr(B$1,IF($N$1=1,$K$3,$K$4),-1,0)

至于测试结论，也没发现明显的差异：四舍五入法、四舍六入五成双、五舍六入法的误差水平差不多。

主要是四舍六入五成双中有一条规则，尾数部分第一位为5时，其余尾数只要有非0数字，就向保留位进1，这直接导致在随机整数、小数位数的情况下，使得四舍六入五成双在绝大多数情况下与四舍五入法保持一致。

不过，可以限定一下随机数，比如取随机小数位为4位，固定近似小数位数为2位或3位，再行测试，或许会验证出“四舍六入五成双”的优异性，是误差最小的。

为了放大差异，我在绝对差异的基础上，引入了平方差异。其实，绝对差异用求和相减的办法，其实也不太好，我用的就是这种。应该试一下：对应数据求差取绝对值再求和的情况，防止正负差异抵消。这一点值得完善。

		自动登录	找回密码
密码			免费注册

[原创] 统一的求近似数自定义函数：n舍m入

评分

评分

最新热点 /1