您的位置:首页 > 其它

RDLC自定义函数 数字转人民币大写(金额) 目前只支持到亿,解决零角问题

2012-08-02 12:22 351 查看
代码一:
'RDLC自定义函数 数字转人民币大写(金额) 目前只支持到亿,解决零角问题
Function CNMoney(ByVal Money As String, Optional ByVal YB As Boolean = True) As String
Dim X, Y As String
Dim I As Integer
Const Zimu = ".sbqwsbqysbqwsbq" ''定义位置代码
Const Letter = "0123456789sbqwy.zjf" ''定义汉字缩写
Const Upcase = "零壹贰叁肆伍陆柒捌玖拾佰仟万亿圆整角分" '定义大写汉字
Dim Temp As String
Try
Temp = Convert.ToString(Format(Convert.ToDouble(Money), "0.00"))
Catch ex As Exception
Throw New NotSupportedException("数据给出错误(非数字格式)!")
CNMoney = "Error."
Exit Function
End Try
If Len(Temp) > 12 Then
Throw New NotSupportedException("数据太大,无法计算(超亿位无法计算)!")
CNMoney = "Error."
Exit Function
End If
If InStr(Temp, ".") > 0 Then Temp = Left(Temp, InStr(Temp, ".") - 1)
X = Format(Convert.ToDouble(Money), "0.00") '格式化货币
Y = ""
For I = 1 To Len(X) - 3
Y = Y & Mid(X, I, 1) & Mid(Zimu, Len(X) - 2 - I, 1)
Next
If Right(X, 3) = ".00" Then
Y = Y & "z" ''***元整
Else
If Right(X, 1) = "0" Then
Y = Y & Left(Right(X, 2), 1) & "j" & "z" '*元*角*整
Else
Y = Y & Left(Right(X, 2), 1) & "j" & Right(X, 1) & "f" ''*元*角*分
End If
End If
Y = Replace(Y, "0q", "0") ''避免零千(如:40200肆萬零千零贰佰)
Y = Replace(Y, "0b", "0") ''避免零百(如:41000肆萬壹千零佰)
Y = Replace(Y, "0s", "0") ''避免零十(如:204贰佰零拾零肆)
Do While Y <> Replace(Y, "00", "0")
Y = Replace(Y, "00", "0") ''避免双零(如:1004壹仟零零肆)
Loop
Y = Replace(Y, "0y", "y") ''避免零億(如:210億 贰佰壹十零億)
If Val(Mid(Right(Temp, 4), 1, 1)) > 0 Then
Y = Replace(Y, "0w", "w0") ''避免无零千(如:102000 拾万贰仟),应该是拾万零贰仟
Else
Y = Replace(Y, "0w", "w") ''避免零萬(如:210萬 贰佰壹十零萬)
End If
'Y = IIf(Len(X) = 5 And Left(Y, 1) = "1", Right(Y, Len(Y) - 1), Y) ''避免壹十(如:14壹拾肆;10壹拾)
Y = IIf(Len(X) = 4, Replace(Y, "0.", ""), Replace(Y, "0.", ".")) ''避免零元(如:20.00贰拾零圆;0.12零圆壹角贰分)
If Len(Temp) >= 9 Then '加
Y = Replace(Y, "yw", "y") '避免亿万元 如 100000000,壹亿万元 应该是壹亿元
End If '加
For I = 1 To 19
Y = Replace(Y, Mid(Letter, I, 1), Mid(Upcase, I, 1)) ''大写汉字
Next
Y = Y.Replace("零角", "零")
If YB = False Then
Y = Y.Replace("圆整", "")
End If

CNMoney = Y
End Function

调用 =code.CNMoney(102.3534)

测试结果:
1409.50 壹仟肆佰零玖圆伍角整
6007.14 陆仟零柒圆壹角肆分
1680.32 壹仟陆佰捌拾圆叁角贰分
107000.53壹拾万零柒仟圆伍角叁分
16409.02壹万陆仟肆佰零玖圆零贰分
325.04 叁佰贰拾伍圆零肆分
900100001.40玖亿零壹拾万零壹圆肆角整

本文是从网上找的,稍微改动了一点,如有问题,留言。

如有更好的办法,请描述,谢谢。

下面的这段代码有点问题,等有时间在改动:

代码二:
Function CNMoney(num As String) As String

If IsNumeric(num) = False Or num = "" Then

CNMoney= num

Exit Function

End If

Dim s1, s2, sin, resultStr, nAmount As String

s1 = "零壹贰叁肆伍陆柒捌玖"

s2 = "亿仟佰拾万仟佰拾亿仟佰拾万仟佰拾元角分"

nAmount = Trim(Str(Val(num) * 100))

Dim numLength As Integer

numLength = Len(Trim(Str(nAmount)))

Dim useStr As String

useStr = Mid(s2, (Len(s2) - numLength + 1), numLength)

Dim zeroCounter, flag As Integer

zeroCounter = 0

flag = 0

Do While flag < Len(nAmount)

flag = flag + 1

Dim cnNum As String

cnNum = Mid(nAmount, flag, 1)

cnNum = Mid(s1, Val(cnNum) + 1, 1)

sin = Mid(useStr, flag, 1)

If cnNum = "零" Then

cnNum = ""

If sin = "亿" Or sin = "元" Then

ElseIf sin = "万" Then

If Mid(resultStr, Len(resultStr), 1) = "亿" Then

sin = ""

End If

Else

sin = ""

End If

zeroCounter = zeroCounter + 1

Else

If zeroCounter > 0 Then

cnNum = "零" + Trim(cnNum)

zeroCounter = 0

End If

End If

resultStr = Trim(resultStr) + Trim(cnNum) + Trim(sin)

Loop

If Mid(nAmount, Len(nAmount), 1) = "0" Then

CNMoney= resultStr + "整"

Else

CNMoney= resultStr

End If

End Function

问题如下:
107000.53壹拾万零柒仟元零伍角叁分

下面的两种写法是正确的:
壹拾万零柒仟元伍角叁分
壹拾万柒仟元零伍角叁分
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: