北京酷猫游戏:如何将一串阿拉伯数字转成中文数字字串

137、如何将一串阿拉伯数字转成中文数字字串？
在我们的应用系统中，有时候要产生一些比较正式的报表 (套表)，例如合约书、电脑开票....等，在这些报表中，关于数字的部份，尤其是金额的部份，为了防止纠纷的产生，通常都必须将阿拉伯数字转成中文大写数字，这种工作，人工做起来很简单，电脑来做，可就要花点工夫了！
以下几个 Function 就是用来处理这个工作的，其中最主要的就是 numbertoword 这个 Function，程序中要呼叫的也就是这个 Function，其他三个 Function 只是配合这个 Function 而已。
‘在程序中只要如右使用即可：返回中文数字 = numbertoword( 阿拉伯数字 )
程序码如下：
Public Function numbertoword(number As String) As String
‘-------------------------------------------------------------------
‘目的:转换一串阿拉伯数字为中文数字
‘参数:一串阿拉伯数字
‘返回值:转换后的一串中文数字
‘---------------------------------------------------------------------------------------------------------------------------------
‘注: 此一 Function 必须包含以下三个 Function
‘1.mapword:转换单一数字为国数字(0123456789->零壹贰参肆伍陆柒捌玖)
‘2.StringCleaner:清除字串中不要的字元
‘3.convtoword:将传入的四个数字转成中文数字字串(1234->壹仟贰佰参拾肆)
‘---------------------------------------------------------------------------------------------------------------------------------
Dim wlength As Integer ‘数字字串总长度
Dim wsection As Integer ‘归属的段落 (0:万以下/1:万/2:亿/3:兆)
Dim wcount As Integer ‘剩余的数字字串长度
Dim wstr As String ‘暂存字串
Dim wstr1 As String ‘暂存字串-兆
Dim wstr2 As String ‘暂存字串-亿
Dim wstr3 As String ‘暂存字串-万
Dim wstr4 As String ‘暂存字串-万以下
‘未输入或0不做
‘-----------------------------------------------
If Trim(number) = "" Or Trim(number) = "0" Then
numbertoword = "零"
Exit Function
End If
‘-----------------------------------------------
wlength = Len(number)
wsection = wlength \ 4
wcount = wlength Mod 4
‘-----------------------------------------------
‘每四位一组, 分段 (兆/亿/万/万以下)
If wcount = 0 Then
wcount = 4
wsection = wsection - 1
End If
‘----------------------------------------------
‘大于兆的四位数转换
If wsection = 3 Then
‘抓出大于兆的四位数
wstr = Left(Format(number, "0000000000000000"), 4)
‘转换
wstr1 = convtoword(wstr)
If wstr1 <> "零" Then wstr1 = wstr1 & "兆"
End If
‘----------------------------------------------
‘大于亿的四位数转换
If wsection >= 2 Then
‘抓出大于亿的四位数
If Len(number) > 12 Then
wstr = Left(Right(number, 12), 4)
Else
wstr = Left(Format(number, "000000000000"), 4)
End If
‘转换
wstr2 = convtoword(wstr)
If wstr2 <> "零" Then wstr2 = wstr2 & "亿"
End If
‘----------------------------------------------
‘大于万的四位数转换
If wsection >= 1 Then
‘抓出大于万的四位数
If Len(number) > 8 Then
wstr = Left(Right(number, 8), 4)
Else
wstr = Left(Format(number, "00000000"), 4)
End If
‘转换
wstr3 = convtoword(wstr)
If wstr3 <> "零" Then wstr3 = wstr3 & "万"
End If
‘----------------------------------------------
‘万以下的四位数转换
‘抓出万以下的四位数
If Len(number) > 4 Then
wstr = Right(number, 4)
Else
wstr = Format(number, "0000")
End If
‘转换
wstr4 = convtoword(wstr)
‘----------------------------------------------
‘组合最多四组字串(兆/亿/万/万以下)
numbertoword = wstr1 & wstr2 & wstr3 & wstr4
‘去除重复的零 (‘零零‘-->‘零‘)
Do While InStr(1, numbertoword, "零零")
numbertoword = StringCleaner(numbertoword, "零零")
Loop
‘----------------------------------------------
‘去除最左边的零
If Left(numbertoword, 1) = "零" Then
numbertoword = Mid(numbertoword, 2)
End If
‘----------------------------------------------
‘去除最右边的零
If Right(numbertoword, 1) = "零" Then
numbertoword = Mid(numbertoword, 1, Len(numbertoword) - 1)
End If
End Function
Public Function mapword(no As String) As String
‘-----------------------------------------------------------
‘目的:转换单一数字为国数字(0123456789->零壹贰参肆伍陆柒捌玖)
‘参数:数字(0123456789)
‘返回值:国数字(零壹贰参肆伍陆柒捌玖)
‘-----------------------------------------------------------
Select Case no
Case "0"
mapword = "零"
Case 1
mapword = "壹"
Case "2"
mapword = "贰"
Case "3"
mapword = "参"
Case "4"
mapword = "肆"
Case "5"
mapword = "伍"
Case "6"
mapword = "陆"
Case "7"
mapword = "柒"
Case "8"
mapword = "捌"
Case "9"
mapword = "玖"
End Select
End Function
Public Function StringCleaner(s As String, Search As String) As String
‘-----------------------------------------------------------
‘目的:清除字串中不要的字元
‘参数:1.完整字串. 2.要清除的字元(可含多字元)
‘返回值:清除后的字串
‘‘‘此段之主要目的在去除重复的 ‘零‘ (‘零零‘-->‘零‘)
‘-----------------------------------------------------------
Dim i As Integer, res As String
res = s
Do While InStr(res, Search)
i = InStr(res, Search)
res = Left(res, i - 1) & Mid(res, i + 1)
Loop
StringCleaner = res
End Function
Public Function convtoword(wstr As String) As String
‘-----------------------------------------------------------
‘目的:将传入的四个数字转成中文数字字串(1234->壹仟贰佰参拾肆)
‘参数:4位数的数字 (前面空白补0)
‘返回值:转换后的中文数字字串
‘-----------------------------------------------------------
Dim tempword As String
‘仟位数
tempword = mapword(Mid(wstr, 1, 1))
If tempword <> "零" Then tempword = tempword & "仟"
convtoword = convtoword & tempword
‘佰位数
tempword = mapword(Mid(wstr, 2, 1))
If tempword <> "零" Then tempword = tempword & "佰"
convtoword = convtoword & tempword
‘拾位数
tempword = mapword(Mid(wstr, 3, 1))
If tempword <> "零" Then tempword = tempword & "拾"
convtoword = convtoword & tempword
‘个位数
tempword = mapword(Mid(wstr, 4, 1))
convtoword = convtoword & tempword
‘去除最右边的零
Do While Right(convtoword, 1) = "零" And Len(convtoword) > 1
convtoword = Mid(convtoword, 1, Len(convtoword) - 1)
Loop
End Function
‘在程序中只要如右使用即可：返回中文数字 = numbertoword( 阿拉伯数字 )
‘-----------------------------------------------------------
‘程序中使用实例 ( 加上错误判断 )
‘在 Form 中放二个 TextBox 及一个 CommandButton
‘Text1 输入数字, Text2 显示转换结果
‘-----------------------------------------------------------
Private Sub Command1_Click()
Text2 = ""
‘去除小数点
If InStr(1, Text1, ".") <> 0 Then
Text1 = Mid(Text1, 1, InStr(1, Text1, ".") - 1)
End If
‘去除逗点
Text1 = StringCleaner(Text1, ",")
‘判断不含非数字
Dim i As Integer
Dim werr As String
For i = 1 To Len(Text1)
If Asc(Mid(Text1, i, 1)) < 48 Or Asc(Mid(Text1, i, 1)) > 57 Then
werr = "Y"
Exit For
End If
Next
If werr = "Y" Then
MsgBox "不可含非数字"
‘focus 回到 text1 方便输入
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
Exit Sub
End If
‘主要程序只一行-----------
Text2 = numbertoword(Text1)
‘-------------------------
‘focus 回到 text1 方便输入
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End Sub
138、如何将一串阿拉伯数字转成英文数字字串？
在在同样情形下，有些情况，我们也必须将阿拉伯数字转成英文数字，以下这个 Function 就是用来处理这个工作的。
‘在程序中只要如右使用即可：返回英文数字 = numtoword( 阿拉伯数字 )
先看看结果：
程序码如下：
Public Function numtoword(numstr As Variant) As String
‘----------------------------------------------------
‘ The best data type to feed in is
‘ Decimal, but it is up to you
‘----------------------------------------------------
Dim tempstr As String
Dim newstr As String
numstr = CDec(numstr)
If numstr = 0 Then
numtoword = "zero "
Exit Function
End If
If numstr > 10 ^ 24 Then
numtoword = "Too big"
Exit Function
End If
If numstr >= 10 ^ 12 Then
newstr = numtoword(Int(numstr / 10 ^ 12))
numstr = ((numstr / 10 ^ 12) - Int(numstr / 10 ^ 12)) * 10 ^ 12
If numstr = 0 Then
tempstr = tempstr & newstr & "billion "
Else
tempstr = tempstr & newstr & "billion, "
End If
End If
If numstr >= 10 ^ 6 Then
newstr = numtoword(Int(numstr / 10 ^ 6))
numstr = ((numstr / 10 ^ 6) - Int(numstr / 10 ^ 6)) * 10 ^ 6
If numstr = 0 Then
tempstr = tempstr & newstr & "million "
Else
tempstr = tempstr & newstr & "million, "
End If
End If
If numstr >= 10 ^ 3 Then
newstr = numtoword(Int(numstr / 10 ^ 3))
numstr = ((numstr / 10 ^ 3) - Int(numstr / 10 ^ 3)) * 10 ^ 3
If numstr = 0 Then
tempstr = tempstr & newstr & "thousand "
Else
tempstr = tempstr & newstr & "thousand, "
End If
End If
If numstr >= 10 ^ 2 Then
newstr = numtoword(Int(numstr / 10 ^ 2))
numstr = ((numstr / 10 ^ 2) - Int(numstr / 10 ^ 2)) * 10 ^ 2
If numstr = 0 Then
tempstr = tempstr & newstr & "hundred "
Else
tempstr = tempstr & newstr & "hundred and "
End If
End If
If numstr >= 20 Then
Select Case Int(numstr / 10)
Case 2
tempstr = tempstr & "twenty "
Case 3
tempstr = tempstr & "thirty "
Case 4
tempstr = tempstr & "forty "
Case 5
tempstr = tempstr & "fifty "
Case 6
tempstr = tempstr & "sixty "
Case 7
tempstr = tempstr & "seventy "
Case 8
tempstr = tempstr & "eighty "
Case 9
tempstr = tempstr & "ninety "
End Select
numstr = ((numstr / 10) - Int(numstr / 10)) * 10
End If
If numstr > 0 Then
Select Case numstr
Case 1
tempstr = tempstr & "one "
Case 2
tempstr = tempstr & "two "
Case 3
tempstr = tempstr & "three "
Case 4
tempstr = tempstr & "four "
Case 5
tempstr = tempstr & "five "
Case 6
tempstr = tempstr & "six "
Case 7
tempstr = tempstr & "seven "
Case 8
tempstr = tempstr & "eight "
Case 9
tempstr = tempstr & "nine "
Case 10
tempstr = tempstr & "ten "
Case 11
tempstr = tempstr & "eleven "
Case 12
tempstr = tempstr & "twelve "
Case 13
tempstr = tempstr & "thirteen "
Case 14
tempstr = tempstr & "fourteen "
Case 15
tempstr = tempstr & "fifteen "
Case 16
tempstr = tempstr & "sixteen "
Case 17
tempstr = tempstr & "seventeen "
Case 18
tempstr = tempstr & "eighteen "
Case 19
tempstr = tempstr & "nineteen "
End Select
numstr = ((numstr / 10) - Int(numstr / 10)) * 10
End If
numtoword = tempstr
End Function
‘在程序中使用实例：Text1是输入的阿拉伯数字，Text2 是返回的英文字
Text2 = numtoword(Text1)