'===============================================================================================
'-函数名称: CnNumber
'-功能描述: 将阿拉伯数字转换成中文数字
'-输入参数: Number 要转换的数字
'-返回参数: 返回转换后得到的中文数字
'-使用示例: =CnNumber(481000001.02) '返回值:四亿八千一百万〇一点〇二
'-相关调用:
'-使用注意:
'-兼 容 性: 最大上限为一亿的3次方,超出此限会出错
'-参考资料:
'-作 者: 红尘如烟
'-创建日期; 2011-7-5
'===============================================================================================
Public Function CnNumber(Number As Variant) As String
Dim strDecimal As String
Dim strInteger As String
Dim lngPos As Long
Dim strNumber As Variant
Dim varNum As String
Dim strCarry As String
Dim lngI As Long
strNumber = CStr(CDec(Number))
lngPos = InStr(1, strNumber, ".")
If lngPos > 0 Then
strDecimal = Mid(strNumber, lngPos + 1)
For lngI = 1 To Len(strDecimal)
varNum = Mid(strDecimal, lngI, 1)
If varNum = 0 Then varNum = 10
Mid(strDecimal, lngI, 1) = Mid("一二三四五六七八九〇", varNum, 1)
Next
strDecimal = "点" & strDecimal
strInteger = StrReverse(Left(strNumber, lngPos - 1))
Else
strInteger = StrReverse(strNumber)
End If
If Number = 0 Then
CnNumber = "〇"
Else
strCarry = " 十 百 千 万 十 百 千 亿 十 百 千 万 十 百 千 亿 十 百 千 万 十 百 千 亿"
strInteger = Replace(strInteger, "-", "")
For lngI = 1 To Len(strInteger)
varNum = Mid(strInteger, lngI, 1)
If varNum = 0 Then varNum = 10
Mid(strCarry, lngI * 2, 1) = Mid$("一二三四五六七八九〇", varNum, 1)
Next
strCarry = Trim(strCarry)
strInteger = StrReverse(strCarry)
strInteger = Mid$(strInteger, InStrRev(strInteger, " ") + 2)
strInteger = Replace(strInteger, "〇十", "〇")
strInteger = Replace(strInteger, "〇百", "〇")
strInteger = Replace(strInteger, "〇千", "〇")
Do Until Not strInteger Like "*〇〇*"
strInteger = Replace(strInteger, "〇〇", "〇")
Loop
strInteger = Replace(strInteger, "十〇", "十")
strInteger = Replace(strInteger, "〇万", "万")
strInteger = Replace(strInteger, "〇亿", "亿")
If Number < 0 Then strInteger = "负" & strInteger
CnNumber = strInteger & strDecimal
End If
End Function