7,765
社区成员
发帖
与我相关
我的任务
分享
Public Function NewRound(ByVal vDouble As Double, Optional ByVal vDecimals As Integer = 0) As Double
Dim strTmp As String
Dim DotPos As Integer
Dim resultNum As Double
strTmp = CStr(vDouble)
DotPos = InStr(strTmp, ".")
If DotPos > 0 Then
If vDecimals < Len(Mid(strTmp, DotPos + 1)) Then
If Val(Mid(strTmp, DotPos + vDecimals + 1, 1)) >= 5 Then
resultNum = Val(Left(strTmp, DotPos + vDecimals)) + 1 / 10 ^ vDecimals
Else
resultNum = Val(Left(strTmp, DotPos + vDecimals))
End If
Else
resultNum = vDouble
End If
Else
resultNum = vDouble
End If
NewRound = resultNum
End Function
If vDecimals < Len(Mid(strTmp, DotPos + 1)) Then
If Val(Mid(strTmp, DotPos + vDecimals + 1, 1)) > 5 Then
resultNum = Val(Left(strTmp, DotPos + vDecimals)) + 1 / 10 ^ vDecimals
ElseIf Val(Mid(strTmp, DotPos + vDecimals + 1, 1)) = 5 Then
If vDecimals = Len(Mid(strTmp, DotPos + 1)) - 1 Then '5后无数字
If (Val(Mid(strTmp, DotPos + vDecimals, 1)) Mod 2) <> 0 Then '保留的末位数是奇数
resultNum = Val(Left(strTmp, DotPos + vDecimals)) + 1 / 10 ^ vDecimals
Else
resultNum = Val(Left(strTmp, DotPos + vDecimals))
End If
Else
resultNum = Val(Left(strTmp, DotPos + vDecimals)) + 1 / 10 ^ vDecimals
End If
Else
resultNum = Val(Left(strTmp, DotPos + vDecimals))
End If
Else
resultNum = vDouble
End If