Public Function myRound(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

解决方案 »

  1.   

    這個更簡單:
    Dim X as Long
    Dim Y as Integer    '小數點的位數X=Foramt(X,"." & String(Y,"0"))
      

  2.   

    最后一應為:
    X=Format(X,"." & String(Y,"0"))
      

  3.   

    回复人: CatchWind(追風少年) ( ) 信誉:98  2004-08-24 14:02:00  得分: 0  
     
       這個更簡單:
    Dim X as Double  '###
    Dim Y as Integer    '小數點的位數X=Format(X,"." & String(Y,"0"))'改在这样可能更适用些.
      

  4.   

    是在做人民币输入时计算用
    改了一下:
    Public Function myRound(sglN As String, lngW As Long) As String
    On Error GoTo err1
        '四舍五入函数
        Dim lngN As Long  '字符总长
        Dim lngD As Long  '记录小数点位置
        Dim lngC As Long  '小数位数
        Dim sglX As String  '小数点后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 = lngN - 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:
    myRound = sglN
    End Function
    另外:
    X=Format(X,"." & String(Y,"0"))这个好象不太对呀