这是实现一个小数四舍五入的功能,看要不要的,要得请加分 '------------------------------------------------------------ ' Function :fcRoundValue ' Description :对数值进行四舍五入计算 ' Parameters :dblValue--数值,lngDecimal--保留小数位数 ' Return :Double--数值 '------------------------------------------------------------ Public Function fcRoundValue(dblValue As Double, lngDecimal As Long) As DoubleDim strTempRemain As String '数值保留部分 Dim lngTempRemain As Long '数值保留部分位数 Dim dblTempRound As Double '数值四舍五入部分 Dim strDecimal As String '小数点位置 Dim strTempValue As String '临时数值变量 Dim dblTempcount As Double '四舍五入的值 Dim lngLoop As Long '循环变量
'如果四舍五入的设定小数位数比实际小数位数要多(实际数值没有小数) If strDecimal = 0 Then fcRoundValue = dblValue Exit Function '如果四舍五入的设定小数位数比实际小数位数多或者相等(实际数值有小数) ElseIf (CLng(strDecimal) + lngDecimal) >= Len(strTempValue) Then fcRoundValue = dblValue Exit Function End If
'如果需要四舍五入(四舍五入部分数值大于等于5) If (dblTempRound >= 5) Then dblTempcount = 1 '计算四舍五入的值 For lngLoop = 1 To lngDecimal dblTempcount = dblTempcount / 10 Next '如果是正值或零值 If (dblValue >= 0) Then '计算最终结果 fcRoundValue = CDbl(strTempRemain) + dblTempcount '如果是负值 ElseIf (dblValue <= 0) Then '计算最终结果 fcRoundValue = CDbl(strTempRemain) - dblTempcount End If '如果不需要四舍五入(四舍五入部分数值小于5) ElseIf (dblTempRound < 5) Then '计算最终结果 fcRoundValue = CDbl(strTempRemain) End If Exit FunctionEnd Function
参考: if IsNumeric(Str) then 用Round()四舍五入 else msgbox "不能四舍五入!" end if
Public Function myRound(ByVal sglN As Double, lngW As Long) As Double On Error GoTo err1 '四舍五入函数 Dim lngN As Long '字符总长 Dim lngD As Long '记录小数点位置 Dim lngC As Long '小数位数 Dim sglX As Double '小数点后lngW-1位以前的数字 Dim lngX2 As Long '保存lngW位的数字(要保留的小数最未位) Dim lngX3 As Long '保存lngW+1位的数字(要舍去的小数第一位)
'计算小数点位置 lngD = InStr(sglN, ".") lngN = Len(sglN)
If lngD = 0 Then myRound = sglN Else sglX = Left(sglN, lngD + (lngW - 1)) lngC = Len(Mid(sglN, lngD + 1, Len(sglN) - lngD)) If lngC > lngW Then lngX2 = Mid(sglN, lngD + lngW, 1) lngX3 = Mid(sglN, lngD + lngW + 1, 1) If lngX3 > 4 Then lngX2 = lngX2 + 1
If lngW = 1 Then myRound = sglX & "." & lngX2 Else myRound = sglX & lngX2 End If Else myRound = sglN End If End If
Exit Function err1: MsgBox "未知错误!", 48, "myRound:" End Function
转换之前最好先判断一下是不是数字的字符串,用isNumeric()
'------------------------------------------------------------
' Function :fcRoundValue
' Description :对数值进行四舍五入计算
' Parameters :dblValue--数值,lngDecimal--保留小数位数
' Return :Double--数值
'------------------------------------------------------------
Public Function fcRoundValue(dblValue As Double, lngDecimal As Long) As DoubleDim strTempRemain As String '数值保留部分
Dim lngTempRemain As Long '数值保留部分位数
Dim dblTempRound As Double '数值四舍五入部分
Dim strDecimal As String '小数点位置
Dim strTempValue As String '临时数值变量
Dim dblTempcount As Double '四舍五入的值
Dim lngLoop As Long '循环变量
'转换数值类型
strTempValue = CStr(dblValue)
'小数点位置
strDecimal = InStr(strTempValue, ".")
'如果四舍五入的设定小数位数比实际小数位数要多(实际数值没有小数)
If strDecimal = 0 Then
fcRoundValue = dblValue
Exit Function
'如果四舍五入的设定小数位数比实际小数位数多或者相等(实际数值有小数)
ElseIf (CLng(strDecimal) + lngDecimal) >= Len(strTempValue) Then
fcRoundValue = dblValue
Exit Function
End If
'取得保留位置部分的数据及数据长度
strTempRemain = Left(strTempValue, (CLng(strDecimal) + lngDecimal))
lngTempRemain = Len(strTempRemain)
'取得数据四舍五入部分的值
dblTempRound = gfcConvzero(CDbl(Mid(strTempValue, lngTempRemain + 1, 1)))
'如果需要四舍五入(四舍五入部分数值大于等于5)
If (dblTempRound >= 5) Then
dblTempcount = 1
'计算四舍五入的值
For lngLoop = 1 To lngDecimal
dblTempcount = dblTempcount / 10
Next
'如果是正值或零值
If (dblValue >= 0) Then
'计算最终结果
fcRoundValue = CDbl(strTempRemain) + dblTempcount
'如果是负值
ElseIf (dblValue <= 0) Then
'计算最终结果
fcRoundValue = CDbl(strTempRemain) - dblTempcount
End If
'如果不需要四舍五入(四舍五入部分数值小于5)
ElseIf (dblTempRound < 5) Then
'计算最终结果
fcRoundValue = CDbl(strTempRemain)
End If Exit FunctionEnd Function
if IsNumeric(Str) then
用Round()四舍五入
else
msgbox "不能四舍五入!"
end if
On Error GoTo err1
'四舍五入函数
Dim lngN As Long '字符总长
Dim lngD As Long '记录小数点位置
Dim lngC As Long '小数位数
Dim sglX As Double '小数点后lngW-1位以前的数字
Dim lngX2 As Long '保存lngW位的数字(要保留的小数最未位)
Dim lngX3 As Long '保存lngW+1位的数字(要舍去的小数第一位)
'计算小数点位置
lngD = InStr(sglN, ".")
lngN = Len(sglN)
If lngD = 0 Then
myRound = sglN
Else
sglX = Left(sglN, lngD + (lngW - 1))
lngC = Len(Mid(sglN, lngD + 1, Len(sglN) - lngD))
If lngC > lngW Then
lngX2 = Mid(sglN, lngD + lngW, 1)
lngX3 = Mid(sglN, lngD + lngW + 1, 1)
If lngX3 > 4 Then lngX2 = lngX2 + 1
If lngW = 1 Then
myRound = sglX & "." & lngX2
Else
myRound = sglX & lngX2
End If
Else
myRound = sglN
End If
End If
Exit Function
err1:
MsgBox "未知错误!", 48, "myRound:"
End Function