人民币大小写转换 & 四舍五入函数

人民币大小写转换代码

Public Function DaXie(txtJE As String) As String

On Error GoTo err1

    Dim i As Long         '循环变量

    Dim K As Long        '记录整数位循环位置

    Dim NC As String      '输入金额 '

    Dim chrNum As String  '保存从字串中取出的数字

    Dim c1 As String       '中文大写单位

    Dim c2 As String       '中文角分

    Dim c3 As String       '中文大写数字

    Dim Zheng As String    '整数部分

    Dim Xiao As String     '小数部分

    NC = Trim(Format(txtJE, "##0.00"))

    c1 = "仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"

    c2 = "角分"

    c3 = "玖捌柒陆伍肆叁贰壹"

    If NC = 0 Then

        DaXie = "零元整"

        Exit Function

    End If

    DaXie = ""

    Zheng = Mid(NC, 1, (Len(NC) - 3))

    Xiao = Mid(NC, (Len(Zheng) + 2), 2)

    If Val(Xiao) <> 0 Then

        For i = Len(Xiao) To 1 Step -1

            chrNum = Mid(Xiao, i, 1)

            If chrNum <> 0 Then

                DaXie = Mid(c2, i, 1) & DaXie

                DaXie = Mid(c3, (Len(c3) - chrNum + 1), 1) & DaXie

            Else

                If i = 1 Then

                    DaXie = "零" & DaXie

                End If

            End If

        Next i

    End If

    K = 0

    If Val(Zheng) <> 0 Then

        DaXie = "元" & DaXie

        For i = Len(Zheng) To 1 Step -1

            If (Len(Zheng) - i) = 4 Then

                If Val(Mid(Zheng, Len(Zheng) - 4, 1)) = 0 And _

                   Mid(DaXie, 1, 1) <> "零" And _

                   Mid(DaXie, 1, 1) <> "元" Then

                    DaXie = "零" & DaXie

                If Len(Zheng) >= 9 Then

                    If Val(Mid(Zheng, Len(Zheng) - 7, 4)) = 0 Then

                        DaXie = DaXie

                    Else

                        DaXie = "万" & DaXie

                    End If

                Else

                    DaXie = "万" & DaXie

                End If

            ElseIf (Len(Zheng) - i) = 8 Then

                If Val(Mid(Zheng, Len(Zheng) - 8, 1)) = 0 And _

                   Mid(DaXie, 1, 1) <> "零" And _

                   Mid(DaXie, 1, 1) <> "元" Then

                    DaXie = "零" & DaXie

                End If

                DaXie = "亿" & DaXie

            ElseIf (Len(Zheng) - i) = 12 Then

                If Val(Mid(Zheng, Len(Zheng) - 12, 1)) = 0 And _

                   Mid(DaXie, 1, 1) <> "零" And _

                   Mid(DaXie, 1, 1) <> "元" Then

                    DaXie = "零" & DaXie

                End If

                DaXie = "万" & DaXie

            End If

            chrNum = Mid(Zheng, i, 1)

            If chrNum <> 0 Then

                If i = Len(Zheng) Then

                    DaXie = Mid(c3, (Len(c3) - chrNum + 1), 1) & DaXie

                Else

                    If (Len(Zheng) - i) <> 4 And _

                       (Len(Zheng) - i) <> 8 And _

                       (Len(Zheng) - i) <> 12 Then

                        DaXie = Mid(c1, (Len(c1) - K), 1) & DaXie

                    End If

                    DaXie = Mid(c3, (Len(c3) - chrNum + 1), 1) & DaXie

                End If

            Else

                If Mid(DaXie, 1, 1) <> "元" And _

                   Mid(DaXie, 1, 1) <> "万" And _

                   Mid(DaXie, 1, 1) <> "亿" Then

                    If Mid(DaXie, 1, 1) <> "零" Then

                        DaXie = "零" & DaXie

                    End If

                End If

           End If

            K = K + 1

        Next i

    End If

    If Right(Trim(DaXie), 1) <> "分" Then

        DaXie = DaXie & "整"

    End If

Exit Function

err1:

DaXie = ""

MsgBox "你输入的数字太长或者格式错误.", , "提示:"

End Function

 

Private Function myRound(ByVal sglT As Double, lngW As Long) As Double

On Error GoTo err1

    '四舍五入函数

    Dim lngN As Long  '字符总长

    Dim lngD As Long  '记录小数点位置

    Dim lngC As String  '小数位数

    Dim sglX As String  '小数点后lngW-1位以前的数字

    Dim lngX2 As Long   '保存lngW位的数字(要保留的小数最未位)

    Dim lngX3 As Long   '保存lngW+1位的数字(要舍去的小数第一位)

    Dim sglN As String

    '计算小数点位置

    sglN = CStr(sglT)

    lngD = InStr(sglN, ".")

   

    If lngD = 0 Then

        myRound = sglN

    Else

        lngN = Len(sglN)

        sglN = Left(sglN, lngD + lngW + 1)

        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 = CDbl(sglN)

        End If

    End If

Exit Function

err1:

MsgBox "未知错误!", 48, "myRound:"

End Function