用Excel2000实现四舍六入
前一阵子答应给同学写一个数据处理的小工具，要在Excel里方便地实现四舍六入五考虑，也就是像5.25这样的数，要保留一位有效数字，结果是5.2，如果是5.15，结果是5.2。也就是如果要保留的最后一位的下一位是5，则看要保留的最后一位。如果是奇数，则进1，如果是偶数，则保持不变，也就是五考虑。这个在实验中对数据处理时用得比较多。
想了一下，正好前几天也看到了类似的文章，就动手做了一下。因为不单纯是四舍五入，做起来要考虑的就多一些。考虑到使用方便，做成宏的方式，自定义一个按纽对应这个宏，点击即可运行。
以下是处理的主过程，其中iPos为要保留的小数点后的位数。有效范围是0-8之间的整数。直接将转换后的数据覆盖原来的数据。这个比较简单，看一下就知道了。
Public Sub process(iPos As Integer)
Dim m As Integer, n As Integer
Dim rang As Range
On Error Resume Next
Set rang = Application.Selection
If (rang.Rows.Count = 0) And (rang.Columns.Count = 0) Then
MsgBox "你得选要处理的数据啊！拖动选取就可以了，真笨！"
End If
For m = 1 To rang.Rows.Count '对每一行
For n = 1 To rang.Columns.Count '对每一列
If rang.Cells(m, n) <> "" Then
rang.Cells(m, n) = GetNumber(rang.Cells(m, n), iPos)
End If
Next n
Next m
Set rang = Nothing
MsgBox "处理完成"
End Sub
在下面这个函数里做具体的转换工具。
先查出小数点的位置。如果小数点后的位数全部保留也不够要保留的位数，也就是像3.14要保留到小数点后5位，那就不管了，直接把原值返回。
如果是0，直接截取小数点以前的所有数值，返回。
如果需要进行舍入处理，则取要保留到的最后一位的下一位，检查这个位的值，如果大于5，则最后一位进1；如果小于5，则最后一位不变；如果等于5，再考虑。
如果最后一位为偶数，则截取需要的位数，返回。如果为奇数，则最后一位加1，返回。
代码中有各步骤的注释。
Private Function GetNumber(f As Double, iPos As Integer) As Double
Dim k As Integer
Dim i As Integer
Dim s As String
Dim s1 As String
s = Trim(Str(f))
i = InStr(1, s, ".") '查找小数点的位置
'检查是否需要进行处理
s1 = s
If iPos = 0 Then
If i > 0 Then s1 = Left(s, i)
Else
'小数点后是否有大于精度的位数。不大于则不需处理
If Len(s) - i > iPos Then
'最后一位<5：舍去，>5：进位，=5：偶进奇舍
s1 = Mid(s, i + iPos + 1, 1)
k = Val(s1)
If k < 5 Then '舍去
s1 = Left(s, i + iPos)
Else
If k > 5 Then '进位
s1 = Mid(s, i + iPos, 1)
k = Val(s1)
k = k + 1
s1 = Left(s, i + iPos - 1) + Trim(Str(k))
Else '奇进偶舍
s1 = Mid(s, i + iPos, 1)
k = Val(s1)
If k Mod 2 = 0 Then
s1 = Left(s, i + iPos)
Else
k = k + 1
s1 = Left(s, i + iPos - 1) + Trim(Str(k))
End If '奇进偶舍结束
End If '进位判断结束
End If '最后一位的下一位大于5
End If '小数点后的位数不足要保存的精度数
End If '保留位数大于0
GetNumber = Val(s1) '送回处理后的数据
End Function
以上程序在w2k+Excel2000下成功运行。
不知道怎么把这个宏自动对所有文档有效，也就是打开excel时自动加载这个宏，新建文档时也有效。望高手指点。
