[原创] 数字修约——四舍六入五单双自定义函数Round2

 'ROUND2(Ref1-数值,Ref2-保留有效位数,Ref3-返回文本或数值,Ref4-遇进位时增加有效位开关）

Function Round2(Num As Double, DIG As Byte, Optional TorV As Boolean, Optional Trn As Boolean) As Variant

Dim Temp1 As Double
Dim TFM As String
Dim Temp2 As String
Dim Tempoff As Double

'-----------------------------------------------
' 鉴于vba中的round与工作表的round不同，这里
' 使用工作表中的round，因为vba中的round有问
' 题。vba中特别同时保留两个round应该是有目的吧，
' 其他函数或操作符一般只有一个
'-----------------------------------------------#此前在首页部分显示#
    If Num = 0 Then
        Temp1 = 0
        Temp2 = "0"
        GoTo ExitFn
    End If
   
    With Application.WorksheetFunction
               
        Tempoff = Abs((--Right(Num / 10 ^ (Int(.Log(Abs(Num))) - DIG + 1), 2) = 0.5) _
        * ((--Right(Int(Abs(Num) / 10 ^ (Int(.Log(Abs(Num))) - DIG + 1)), 1) _
        Mod 2) = 0)) * 10 ^ Int(.Log(Abs(Num)) - DIG + 1)
       
        Temp1 = .Round(Abs(Num), -(Int(.Log(Abs(Num))) - DIG + 1))
        Temp1 = Temp1 - Tempoff
       
        Trn = Trn And (10 ^ Int(.Log(Temp1)) = Temp1 And Temp1 > Abs(Num))
       
        If DIG > 14 And Trn Then
            Temp2 = "有效位数超过14位不能进位"
            GoTo ExitFn
        End If
       
        If DIG = 1 And Int(.Log(Abs(Temp1))) = 0 And Not Trn Then
            TFM = ""
        Else
            If Not (DIG = 1 And Int(Temp1) = Temp1 And Not Trn) Then TFM = TFM & "."
            TFM = TFM & .Rept("0", DIG + Abs(Trn) - 1)
        End If
       
        TFM = "0" & TFM
       
        If Int(.Log(Temp1)) < 0 Then
            TFM = TFM & .Rept("0", -Int(.Log(Temp1)))
        ElseIf Int(.Log(Temp1)) > 0 Then
            TFM = TFM & "E+###"
        End If
       
        Temp1 = Temp1 * Sgn(Num)
        Temp2 = .Text(Temp1, TFM)
    End With
       
ExitFn:
        If TorV Then
           Round2 = Temp2
        Else
           Round2 = Temp1

        End If
End Function

http://blog.excelhome.net/UploadFiles/2006-2/23890517.rar