有网友提出过这样的问题“我想实现四舍六入逢五奇进偶不进”。遇到这种问题,我们都需要是自定义函数。
详细源码:Function Rvt(ByVal x As Double, ByVal n As Integer) As Double' 四舍六入逢五奇进偶不进的函数(Access VBA)' 作者:朱亦文 Const IFIX = 15 Dim sFmt As String Dim sRet As String, sTmp As String Dim intR As Integer, intRT As Integer If n < 0 Then n = 0 sFmt = "0." & String(n + IFIX, "0") sTmp = Format(x, sFmt) If n = 0 Then intR = CInt(Left(Right(sTmp, IFIX + 2), 1)) intRT = CInt(Left(Right(sTmp, n + IFIX), 1)) sRet = Left(sTmp, Len(sTmp) - n - IFIX - 1) Else intR = CInt(Left(Right(sTmp, n + IFIX), 1)) intRT = CInt(Left(Right(sTmp, n + IFIX - 1), 1)) sRet = Left(sTmp, Len(sTmp) - n - IFIX + 1) End If If intRT = 5 Then If intR Mod 2 = 0 Then Rvt = CDbl(sRet) Else Rvt = Round(x, n) End If Else Rvt = Round(x, n) End IfEnd Function立即窗口验证:?Rvt(9992.45,1) 9992.4 ?Rvt(9992.55,1) 9992.6 ?Rvt(9992.54,1) 9992.5 ?Rvt(9992.46,1) 9992.5 ?Rvt(-9991.45015,1)-9991.4 ?Rvt(-9992.565015,0)-9992 ?Rvt(-9991.565015,0)-9992 另分享一个函数(银行家算法):Function BRound(ByVal X As Double, _ Optional ByVal Factor As Double = 1) As Double ' For smaller numbers: ' BRound = CLng(X * Factor) / Factor Dim Temp As Double, FixTemp As Double Temp = X * Factor FixTemp = Fix(Temp + 0.5 * Sgn(X)) ' Handle rounding of .5 in a special manner If Temp - Int(Temp) = 0.5 Then If FixTemp / 2 <> Int(FixTemp / 2) Then ' Is Temp odd ' Reduce Magnitude by 1 to make even FixTemp = FixTemp - Sgn(X) End If End If BRound = FixTemp / FactorEnd Function