VB6 人民币小写转大写转换

 

 Option Explicit 

Public Function NumberToCharacter(number As StringAs String 
'完成转换的主函数 
Dim Pos_Point As Long '记录小数点的位置 
Dim curNum As String '记录当前处理的数字 
Dim zhengshu As String '记录整数部分 
Dim shuduan As String '截取某一个数据段 
'
检索小数点的位置 
Pos_Point = InStr(number, "."
'处理小数部分 
If Pos_Point = 0 Then 
'没有小数点,将小数点设置在最末尾 
Pos_Point = Len(number) 
ElseIf Len(number) = Pos_Point Then 
'以小数点结尾,不作处理 
ElseIf Len(number) = Pos_Point + 1 Then 
'一位小数,直接翻译为角 
curNum = Right(number, 1
NumberToCharacter 
= NumToChr(curNum) & "" 
ElseIf Len(number) = Pos_Point + 2 Then 
'取第一位 
curNum = Right(number, 1
'若第一位为零,则不作处理,否则译为“角” 
If curNum <> "0" Then 
NumberToCharacter 
= NumToChr(curNum) & "" 
End If 
'取第二位 
curNum = Left(Right(number, 2), 1
'若第二为零,不作处理,否则译为“分” 
If curNum <> "0" Then 
NumberToCharacter 
= NumToChr(curNum) & "" & NumberToCharacter 
End If 
End If 

'处理整数 
zhengshu = "" 
If Pos_Point > 14 Then 
'大于 9999999999999 的数据不转换 
MsgBox "该数据无法转换", vbOKOnly + vbInformation, "金额转换" 
Exit Function 
ElseIf Pos_Point > 9 Then 
zhengshu 
= "亿" 
'亿位以上的部分 
shuduan = Left(number, Pos_Point - 9
zhengshu 
= shuduantoCharacter(shuduan) & zhengshu 
'万位以上的部分 
shuduan = Right(Left(number, Pos_Point - 5), 4
zhengshu 
= zhengshu & shuduantoCharacter(shuduan) & "" 
'万位以下部分 
shuduan = Right(Left(number, Pos_Point - 1), 4
zhengshu 
= zhengshu & shuduantoCharacter(shuduan) & "" 
ElseIf Pos_Point > 5 Then 
'万位以上的部分 
shuduan = Right(Left(number, Pos_Point - 5), 4
zhengshu 
= zhengshu & shuduantoCharacter(shuduan) & "" 
'万位以下部分 
shuduan = Right(Left(number, Pos_Point - 1), 4
zhengshu 
= zhengshu & shuduantoCharacter(shuduan) & "" 
Else 
'万位以下 
shuduan = Right(Left(number, Pos_Point - 1), 4
zhengshu 
= zhengshu & shuduantoCharacter(shuduan) & "" 
End If 
NumberToCharacter 
= zhengshu & NumberToCharacter 
'输入为“0”,特殊处理 
If NumberToCharacter = "" Then 
NumberToCharacter 
= "零圆" 
End If 

End Function 

Public Function NumToChr(num As StringAs String 
'数字转化为对应的中文 
Select Case num 
Case "1" 
NumToChr 
= "" 
Case "2" 
NumToChr 
= "" 
Case "3" 
NumToChr 
= "" 
Case "4" 
NumToChr 
= "" 
Case "5" 
NumToChr 
= "" 
Case "6" 
NumToChr 
= "" 
Case "7" 
NumToChr 
= "" 
Case "8" 
NumToChr 
= "" 
Case "9" 
NumToChr 
= "" 
Case "0" 
NumToChr 
= "" 
End Select 
End Function 

'对分节后的每一节数据进行翻译, 
'
例如: 1234512341234被分为12345,1234,1234 
Public Function shuduantoCharacter(duan As StringAs String 
Dim curNum As String 
Dim answer As String 
answer 
= "" 
If Len(duan) = 5 Then 
'有万位 
answer = NumToChr(Left(duan, 1)) & "" 
'千位 
curNum = Right(Left(duan, 2), 1
If curNum <> "0" Then 
answer 
= answer & NumToChr(curNum) & "" 
Else 
answer 
= answer & "" 
End If 
'百位 
curNum = Right(Left(duan, 3), 1
If curNum <> "0" Then 
answer 
= answer & NumToChr(curNum) & "" 
Else 
If Right(answer, 1<> "" Then 
answer 
= answer & "" 
End If 
End If 
'十位 
curNum = Right(Left(duan, 4), 1
If curNum <> "0" Then 
answer 
= answer & NumToChr(curNum) & "" 
Else 
If Right(answer, 1<> "" Then 
answer 
= answer & "" 
End If 
End If 
'个位 
curNum = Right(duan, 1
If curNum <> "0" Then 
answer 
= answer & NumToChr(curNum) 
Else 
If Right(answer, 1= "" Then 
answer 
= Left(answer, Len(answer) - 1
End If 
End If 
ElseIf Len(duan) = 4 Then 
'有千位 
answer = NumToChr(Left(duan, 1)) & "" 
'百位 
curNum = Left(Right(duan, 3), 1
If curNum <> "0" Then 
answer 
= answer & NumToChr(curNum) & "" 
Else 
If Right(answer, 1<> "" Then 
answer 
= answer & "" 
End If 
End If 
'十位 
curNum = Left(Right(duan, 2), 1
If curNum <> "0" Then 
answer 
= answer & NumToChr(curNum) & "" 
Else 
If Right(answer, 1<> "" Then 
answer 
= answer & "" 
End If 
End If 
'个位 
curNum = Right(duan, 1
If curNum <> "0" Then 
answer 
= answer & NumToChr(curNum) 
Else 
If Right(answer, 1= "" Then 
answer 
= Left(answer, Len(answer) - 1
End If 
End If 
ElseIf Len(duan) = 3 Then 
'有百位 
answer = NumToChr(Left(duan, 1)) & "" 
'十位 
curNum = Left(Right(duan, 2), 1
If curNum <> "0" Then 
answer 
= answer & NumToChr(curNum) & "" 
Else 
If Right(answer, 1<> "" Then 
answer 
= answer & "" 
End If 
End If 
'个位 
curNum = Right(duan, 1
If curNum <> "0" Then 
answer 
= answer & NumToChr(curNum) 
Else 
If Right(answer, 1= "" Then 
answer 
= Left(answer, Len(answer) - 1
End If 
End If 
ElseIf Len(duan) = 2 Then 
'有十位 
answer = NumToChr(Left(duan, 1)) & "" 
'个位 
curNum = Right(duan, 1
If curNum <> "0" Then 
answer 
= answer & NumToChr(curNum) 
Else 
If Right(answer, 1= "" Then 
answer 
= Left(answer, Len(answer) - 1
End If 
End If 
ElseIf Len(duan) = 1 Then 
'有个位 
answer = NumToChr(Left(duan, 1)) 
End If 
shuduantoCharacter 
= answer 

End Function
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值