如何把阿拉伯数字转中文的函数（如：10转十）

时　间:2011-07-14 00:00:00
作　者:hjs   ID：4770  城市：泸州
摘　要:拿来主义
正　文:

如何把阿拉伯数字转中文的函数（如：10转十），虽然红尘如烟老大的函数很给力，但是觉得这个更好：（我拿来的，改了一句，希望大家有用，这个解决了如15转一十五的问题。）

Public Function UpNumber(ByVal number As Double, Optional ByVal Typ As Long, Optional ByVal IsMoney As Boolean) As String
'--------------------------------------------------------------------------------'
'参数说明:
'Number         待转换的数字,可以是小数.
'Typ            转换类型,可选值 0,1
'0              转换为 零,壹,贰 等
'1              转换为 一,二,三 等
'IsMoney        是否是金额,如果是,则转换为多少元,小数后转换为多少角,分,反之则转换为类似于"二点三"这种形式
'例子:
'Debug.Print UpNumber(-612325646566.46, 0, True)
'负陆仟壹佰贰拾叁亿贰仟伍佰陆拾肆万陆仟伍佰陆拾陆圆肆角陆分
'Debug.Print UpNumber(-125646566.46, 1, True)
'负一亿二千五百六十四万六千五百六十六元四角六分
'Debug.Print UpNumber(-125646566.46, 1, flase)
'负一亿二千五百六十四万六千五百六十六点四六

    On Error GoTo Doerr

    Dim Result As String                        '返回值
    Dim strNumber As String                     '文本型的 Number
    Dim lngNumberLen As Long                    '文本型的 Number 的 Len

    Dim strTmp As String
    Dim strFirst As String, strEnd As String
    Dim lngI As Long, lngJ As Long, lngTmp As Long

    Dim strNum(10) As String                    '大写数字
    Dim strUnit(16) As String                   '单位,比如 十,拾,万等
    Dim strUnitB(2) As String                   '小数后的单位

    '初始化
    Select Case Typ
    Case 0
        strNum(0) = "零": strNum(1) = "壹": strNum(2) = "贰": strNum(3) = "叁"
        strNum(4) = "肆": strNum(5) = "伍": strNum(6) = "陆": strNum(7) = "柒"
        strNum(8) = "捌": strNum(9) = "玖"

        If IsMoney Then
            strUnit(0) = "圆"
            strUnitB(0) = "角": strUnitB(1) = "分"
        Else
            strUnit(0) = "点"
        End If

        strUnit(1) = "拾": strUnit(2) = "佰": strUnit(3) = "仟": strUnit(4) = "万"
        strUnit(5) = "拾": strUnit(6) = "佰": strUnit(7) = "仟": strUnit(8) = "亿"
        strUnit(9) = "拾": strUnit(10) = "佰": strUnit(11) = "仟": strUnit(12) = "万"
        strUnit(13) = "拾": strUnit(14) = "佰": strUnit(15) = "仟"

    Case 1
        strNum(0) = "零": strNum(1) = "一": strNum(2) = "二": strNum(3) = "三"
        strNum(4) = "四": strNum(5) = "五": strNum(6) = "六": strNum(7) = "七"
        strNum(8) = "八": strNum(9) = "九"

        If IsMoney Then
            strUnit(0) = "元"
            strUnitB(0) = "角": strUnitB(1) = "分"
        Else
            strUnit(0) = "点"
        End If

        strUnit(1) = "十": strUnit(2) = "百": strUnit(3) = "千": strUnit(4) = "万"
        strUnit(5) = "十": strUnit(6) = "百": strUnit(7) = "千": strUnit(8) = "亿"
        strUnit(9) = "十": strUnit(10) = "百": strUnit(11) = "千": strUnit(12) = "万"
        strUnit(13) = "十": strUnit(14) = "百": strUnit(15) = "千"

Case Else
        '参数错误
        GoTo Errexit
    End Select

    Result = ""
    If number = 0 Then
        If IsMoney Then
            Result = strNum(0) & strUnit(0) & "" '整"
        Else
            Result = strNum(0)
        End If
    Else
        If IsMoney Then
            strNumber = Trim(str(FormatCurrency(number, 2, vbTrue, vbFalse, vbFalse)))       '保留两位小数
        Else
            strNumber = Trim(str(number))                                                    '简单的转换为字符串型
        End If
        lngNumberLen = Len(strNumber)

        If Left(strNumber, 1) = "-" Then                    '处理负数
            strFirst = "负"
            strNumber = Right(strNumber, lngNumberLen - 1)
            lngNumberLen = lngNumberLen - 1
        Else
            strFirst = ""                                   '通常不需要 =""
        End If

        lngI = InStrRev(strNumber, ".")
        If lngI Then
            strTmp = Right(strNumber, lngNumberLen - lngI)
            If IsMoney Then
                strTmp = strTmp & "00"
                strEnd = ""                                 '通常不需要 =""

                For lngJ = 1 To 2
                    Result = Result & strNum(CLng(Mid$(strTmp, lngJ, 1))) & strUnitB(lngJ - 1)
                Next
            Else
                strTmp = Right(strNumber, lngNumberLen - lngI)
                For lngJ = 1 To lngNumberLen - lngI
                    Result = Result & strNum(CLng(Mid$(strTmp, lngJ, 1)))
                Next
            End If

            strNumber = Left(strNumber, lngI - 1)           '去除小数部分
            lngNumberLen = Len(strNumber)                   '新的字符串长度
        Else
            If IsMoney Then
                strEnd = "整"
            Else
                strEnd = ""
            End If
        End If

 '以下为主循环部分
        lngI = 0
        For lngJ = lngNumberLen To 1 Step -1
            lngTmp = CLng(Mid$(strNumber, lngJ, 1))

            If lngTmp Then
                Result = strNum(lngTmp) & strUnit(lngI) & Result
            Else
                If lngI = 0 or lngI = 4 or lngI = 8 or lngI = 12 Then           '超过 16 位不支持
                    Result = strNum(lngTmp) & strUnit(lngI) & Result
                Else
                    Result = strNum(lngTmp) & Result
                End If
            End If

            lngI = lngI + 1
        Next

        Result = Replace(Result, strNum(0) & strNum(0), strNum(0))              '零零", "零
        Result = Replace(Result, strNum(0) & strNum(0), strNum(0))              '零零", "零

        '亿零万零圆", "亿圆"
        Result = Replace(Result, strUnit(8) & strNum(0) & strUnit(4) & strNum(0) & strUnit(0), strUnit(8) & strUnit(0))

        Result = Replace(Result, strUnit(8) & strNum(0) & strUnit(4), strUnit(8) & strNum(0))       '亿零万, "亿零"
        Result = Replace(Result, strUnit(4) & strNum(0) & strUnit(0), strUnit(4) & strUnit(0))      '亿零万", "亿零

        Result = Replace(Result, strNum(0) & strUnit(8), strUnit(8))            '零亿
        Result = Replace(Result, strNum(0) & strUnit(4), strUnit(4))            '零万
        Result = Replace(Result, strNum(0) & strUnit(0), strUnit(0))            '零圆

        Result = Replace(Result, strNum(0) & strNum(0), strNum(0))              '零零", "零
        Result = Replace(Result, strNum(0) & strNum(0), strNum(0))              '零零", "零

        If IsMoney Then
            Result = strFirst & Result & strEnd
        Else
            Result = strFirst & Result
            If Right(Result, 1) = strUnit(0) Then Result = Left(Result, Len(Result) - 1)            '去除最后一个 "点"
        End If
    End If

Complete:
    GoTo Quit
Doerr:
Errexit:
    Result = ""
Quit:
    UpNumber = Result
    If number >= 10 And number < 20 Then
    UpNumber = Replace(UpNumber, "一十", "十")
    End If

End Function