1、将阿拉伯数字转换为汉字数字,支持到百万亿作者：unknown 更新时间：2005-03-17 例子: Debug.Print UpNumber(-10556765765555.45,0,True ) 显示为: 负壹拾万伍仟伍佰陆拾柒亿陆仟伍佰柒拾陆万伍仟伍佰伍拾伍圆肆角零分 Public Function UpNumber(ByVal Number As Double, Optional ByVal Typ As Long, Optional ByVal IsMoney As Boolean) As String * - 将阿拉伯数字转换为大写字符串 Version 1.0 2002-02-0
2、6 Version 1.1 2002-04-05 修改到支持到千亿 Version 1.2 2004-08-14 修改为支持 Typ,IsMoney 参数,转换结果可以不是金额,支持到百万亿 Roadbeg - - 参数说明: Number 待转换的数字,可以是小数. Typ 转换类型,可选值 0,1 0 转换为 零,壹,贰 等 1 转换为 一,二,三 等 IsMoney 是否是金额,如果是,则转换为多少元,小数后转换为多少角,分,反之则转换为类似于“二点三“这种形式 - - 返回值说明: 如果成功,返回转换后的字符串 如果失败,返回空字符串 - - 注意,此函数最大只支持到百万亿 没有对 T
3、yp 的值进行检查,如果 Typ 不为 0,1 之一,将会引发错误. 另,由于 Double 类型数值范围的原因,超过百万亿,将不能显示小数,同样的超过十万亿只能显示一个小数,以此类推. - * 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
4、, 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) = “柒“: strNu
5、m(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) =
6、 “佰“: 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)
7、 = “元“ 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
8、) = “十“: 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) 保留两位小数
9、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
10、= 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 &
11、 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 Th
12、en 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
13、) 零零“, “零 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) 亿零万, “亿零“ Resul
14、t = 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(Res
15、ult, strNum(0) & strNum(0), strNum(0) 零零“, “零 Result = Replace(Result, strNum(0) & strNum(0), strNum(0) 零零“, “零 If IsMoney Then Result = strFirst & Result & strEnd Else 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 End Function
