主题:如何将罗马数字转化为中文数字?(比如:6501,中文为:六千五百零一)
xipx
[专家分:0] 发布于 2008-06-19 02:41:00
各位有好办法吗?
回复列表 (共3个回复)
沙发
wwc7654321 [专家分:1590] 发布于 2010-02-25 22:07:00
很简单啊,按读音规则写就是了
从左向右读
当某位不为0时:
先读出该数字
除4余3位数的读千
余2读百
余1读十
当某位为0时:
读零,连续的0只读一次
逢8位倍数读亿(如果前8位为0且尾数不全为0时不读)
逢4位倍数但非8位倍数读万(如果前4位为0时不读)
板凳
wwc7654321 [专家分:1590] 发布于 2010-02-25 22:09:00
哇,才发现是2年前的帖子……
有够清静的,怪不得第一页满是零回复的热帖
3 楼
wwc7654321 [专家分:1590] 发布于 2010-02-25 22:09:00
Function UCaseNum(StrNum)
Dim fo, result, f, ws
On Error Resume Next
Const UCaseNums = "零一二三四五六七八九"
StrNum = Replace(StrNum, " ", "")
For fo = 1 To Len(StrNum)
If Asc(Mid(StrNum, fo, 1)) = 48 Then
If f < 2 Then f = f + 1
Else
f = 0
End If
If f < 2 Then UCaseNum = UCaseNum & Mid(UCaseNums, Asc(Mid(StrNum, fo, 1)) - 47, 1)
ws = (Len(StrNum) - fo)
If ws Mod 4 Then
ws = ws Mod 4
If f = 0 Then
If ws Mod 3 Then
If ws Mod 2 Then
UCaseNum = UCaseNum & "十"
Else
UCaseNum = UCaseNum & "百"
End If
Else
If Asc(Mid(StrNum, fo - 1, 1)) = 48 Then UCaseNum = Left(UCaseNum, Len(UCaseNum) - 2) & Right(UCaseNum, 1)
UCaseNum = UCaseNum & "千"
End If
End If
ElseIf (ws Mod 8) = 0 And ws And (f < 3 Or Len(Replace(Mid(StrNum, fo, Len(StrNum) - fo + 1), "0", "")) = 0) Then
If Mid(StrNum, fo - 7, 8) <> String(8, "0") Or f = 3 Then
If Asc(Mid(StrNum, fo, 1)) = 48 Then UCaseNum = Left(UCaseNum, Len(UCaseNum) - 1) & "亿零" Else UCaseNum = UCaseNum & "亿"
Else
f = 3
End If
If f Then f = 3
ElseIf ws And (f < 3) Then ' Or Len(Replace(Mid(StrNum, fo, Len(StrNum) - fo + 1), "0", "")) = 0
If Mid(StrNum, fo - 3, 4) <> String(4, "0") Then 'Or f = 3
If Asc(Mid(StrNum, fo, 1)) = 48 Then UCaseNum = Left(UCaseNum, Len(UCaseNum) - 1) & "万零" Else UCaseNum = UCaseNum & "万"
Else
End If
If f Then f = 3
End If
Next
'UCaseNum = Replace(UCaseNum, "亿万", "亿")
If f <> 0 Then UCaseNum = Left(UCaseNum, Len(UCaseNum) - 1)
End Function
MsgBox UCaseNum("560 0000 0001")
MsgBox UCaseNum("560 0000 0010")
MsgBox UCaseNum("56010100000")
MsgBox UCaseNum("56111111111")
MsgBox UCaseNum("56001111111")
MsgBox UCaseNum("1 0000 0000 0000 0000")
我来回复