“四舍六入五单双”利用VBA自定义函数解决

利用VBA自定义函数解决

业务研究加入时间：2007-3-9 20:42:35 点击：504

Microsoft Office套装办公软件是大家十分熟悉的办公软件，在工作中经常使用。但在水文工作中，仍然感觉到有很不方便的时候！比如，水文行业广泛使用的“四舍六入五单双”，就很难用Microsoft Office中的内部函数进行处理。但是与Microsoft Office套装办公软件绑定的VBA(Visual Basic For Application)语言提供了强大的二次开发功能，笔者以Excel为例，用它来解决上面所提到的问题，就非常容易了。

一、水文及水质资料使用的“四舍六入五单双”，执行《数值修约规范》（GB8170-87）１.拟舍弃数字的最左一位数字小于５时，则舍去，即保留的各位数字不变。

２.拟舍弃数字的最左一位数字大于５时；或者是５，而其后跟有并非全部为０的数字时，则进一，即保留的末位数字加１。

３. 拟舍弃数字的最左一位数字为５，而后面无数字或皆为０时，若所保留的末位数字为奇数(1,3,5,7,9)则进一，为偶数(２,4,6,8)则舍弃。

二、初识VBAIDE

打开Excel，按Alt+F11即进入VBAIDE，在菜单上依次点击[插入]->[模块]，然后输入如下代码：

' “四舍六入五单双”自定义函数

' 函数形式 Round5(x,mm)，返回值Round5为 Double 型

' X为操作数值，mm为保留小数位数

' mm为 Integer 型，mm = 0 表示取整数

Private Function round5(X As Double, mm As Integer) As Double

Dim Temp1, Temp2 As String

Temp1 = 1

If mm < 0 Then

Temp1 = 10 ^ Abs(mm)

X = X / Temp1

mm = 0

End If

If ((Int((Abs(X) - Int(Abs(X))) * 10 ^ mm) Mod 2) = 0 And (Abs(X) * 10 ^ mm - Int(Abs(X) * 10 ^ mm)) <= 0.5) And X <> Val(Round(Abs(X), mm) * Sgn(X)) Then

round5 = Val((Round(Abs(X) - 10 ^ (-mm) / 5, mm)))

Else

round5 = Val(Round(Abs(X), mm))

End If

round5 = Val( round5 * Sgn(X) * Temp1)

End Function

以上程序是在“取绝对值（Abs）”、“取整（Int）”、“四舍五入（Round）”等系统内部函数的基础上完成的，函数的型式及其每个参数需要用户在属性设置中定义和声明，故叫做自定义函数。以上定义“四舍六入五单双”的函数名为Round5，定义成功后便可在Excel 中象系统函数那样引用了，例如对编辑完后按Alt+Q即返回Excel，再在某一单元格输入“= Round5(A1,３)”(A1既可以是单元格,也可以是输入的数值),回车结果就出来了。如果出现

“#NAME？”那就要设置一下安全设置。依次点[工具]->[宏]->[安全性]，在安全级选项卡上选择“中”或者“低”，然后关闭后重新打开就可以了，如果保存为“加载宏”，以后只要是“四舍六入五单双”的计算，就可以直接用它，非常方便。VBA的功能是非常强大的，如果读者有兴趣，一定可以解决不少难题。