求人民币 大写 的转换 函数 ????????????????? 急!!!!!!!!!!!!!!!!!!!

fsqman 2006-12-20 01:07:25
比如将265.63转换成‘贰佰陆拾伍元陆角叁分’。
...全文
297 13 打赏 收藏 转发到动态 举报
写回复
用AI写文章
13 条回复
切换为时间正序
请发表友善的回复…
发表回复
Vb_Net4Zeng 2006-12-21
  • 打赏
  • 举报
回复
Public Function funRMBDXnew(ByVal p_Objects() As Object) As String
Dim m_MoneyString As String = Val(p_Objects(0))
Dim m_MoneyZHSB, m_MoneyXSBF As String
Dim m_IsMinus As Boolean = False
Dim m_SplitString As String = "(?<fh>-{1})?(?<zhbf>\d*)?\.?(?<xsbf>\d{0,2})"
Dim m_SplitZHBF As String = "(?<fh>-{1})?(?<qyi>\d{1})?(?<byi>\d{1})?(?<syi>\d{1})?(?<yi>\d{1})?(?<qwan>\d{1})?(?<bwan>\d{1})?(?<swan>\d{1})?(?<wan>\d{1})?(?<qian>\d{1})?(?<bai>\d{1})?(?<shi>\d{1})?(?<yuan>\d{1})?"
Dim m_ReplaceZHBF As String = "${qyi}仟${byi}佰${syi}拾${yi}亿${qwan}仟${bwan}佰${swan}拾${wan}万${qian}仟${bai}佰${shi}拾${yuan}元"
Dim m_SplitSHBF As String = "(?<jiao>\d{1})(?<fen>\d{1})?"
Dim m_ReplaceSHBF As String = "${jiao}角${fen}分"

Dim m_Group As GroupCollection
Dim m_Match As Match
'判断是否零
If m_MoneyString = "0" Then Return "零"

m_Match = Regex.Match(m_MoneyString, m_SplitString, RegexOptions.IgnoreCase)
m_Group = m_Match.Groups
'判断是否为负数
If m_Group("fh").Value = "-" Then m_IsMinus = True
m_MoneyZHSB = m_Group("zhbf").Value
m_MoneyXSBF = m_Group("xsbf").Value

If m_MoneyZHSB <> "0" Then
'求整数部分
m_MoneyZHSB = Regex.Replace(m_MoneyZHSB, m_SplitZHBF, m_ReplaceZHBF, RegexOptions.IgnoreCase Or RegexOptions.RightToLeft)
'整理
m_Match = Regex.Match(m_MoneyZHSB, "\d{1}.*")
m_MoneyZHSB = m_Match.Value
m_MoneyZHSB = Regex.Replace(m_MoneyZHSB, "(?<sp>0[^亿万元])", "0")
m_MoneyZHSB = Regex.Replace(m_MoneyZHSB, "(?<ling>0+)", "零")
m_MoneyZHSB = Regex.Replace(m_MoneyZHSB, "零(?<ling>[亿万元]+)", "${ling}")
m_MoneyZHSB = m_MoneyZHSB.Replace("亿万", "亿")
Else
m_MoneyZHSB = String.Empty
End If

'求小数部分
m_MoneyXSBF = Regex.Replace(m_MoneyXSBF, m_SplitSHBF, m_ReplaceSHBF, RegexOptions.IgnoreCase)
'整理
m_Match = Regex.Match(m_MoneyXSBF, "\w{0,4}")
m_MoneyXSBF = m_Match.Value
m_MoneyXSBF = Regex.Replace(m_MoneyXSBF, "0(?<jiao>角)?", "")
m_MoneyXSBF = Regex.Replace(m_MoneyXSBF, "角(?<sp>分)", "角")

'联合整理
m_MoneyString = m_MoneyZHSB & m_MoneyXSBF & "整"
m_MoneyString = m_MoneyString.Replace("1", "壹")
m_MoneyString = m_MoneyString.Replace("2", "贰")
m_MoneyString = m_MoneyString.Replace("3", "叁")
m_MoneyString = m_MoneyString.Replace("4", "肆")
m_MoneyString = m_MoneyString.Replace("5", "伍")
m_MoneyString = m_MoneyString.Replace("6", "陆")
m_MoneyString = m_MoneyString.Replace("7", "柒")
m_MoneyString = m_MoneyString.Replace("8", "捌")
m_MoneyString = m_MoneyString.Replace("9", "玖")
m_MoneyString = m_MoneyString.Replace("0", "零")

Return IIf(m_IsMinus, "(红字)" & m_MoneyString, m_MoneyString)

End Function
看起来是否很郁闷的代码?
踏平扶桑 2006-12-20
  • 打赏
  • 举报
回复
Option Explicit

Private Sub Command1_Click()
Text1.Text = Format(Text1.Text, "0.00")
change (Text1.Text)
End Sub

Function change(str As String) As String
Dim i As Integer
Dim chn, chntmp As String
If Len(str) > 11 Then
MsgBox "对不起,只能处理千万之内的数据"
Exit Function
End If
If InStr(1, str, ".", vbTextCompare) Then '处理带有小数
For i = 1 To Len(str) - 3 '整数部分处理
Select Case Mid(str, i, 1)
Case 0
chn = chn & "零"
Case 1
chn = chn & "壹"
Case 2
chn = chn & "贰"
Case 3
chn = chn & "叁"
Case 4
chn = chn & "肆"
Case 5
chn = chn & "伍"
Case 6
chn = chn & "陆"
Case 7
chn = chn & "柒"
Case 8
chn = chn & "捌"
Case 9
chn = chn & "玖"
End Select
Next
Select Case Len(chn)
Case 2
chn = Mid(chn, Len(chn) - 1, 1) & "拾" & Mid(chn, Len(chn), 1)
Case 3
chn = Mid(chn, Len(chn) - 2, 1) & "佰" & Mid(chn, Len(chn) - 1, 1) & "拾" & Mid(chn, Len(chn), 1)
Case 4
chn = Mid(chn, Len(chn) - 3, 1) & "仟" & Mid(chn, Len(chn) - 2, 1) & "佰" & Mid(chn, Len(chn) - 1, 1) & "拾" & Mid(chn, Len(chn), 1)
Case 5
chn = Mid(chn, Len(chn) - 4, 1) & "万" & Mid(chn, Len(chn) - 3, 1) & "仟" & Mid(chn, Len(chn) - 2, 1) & "佰" & Mid(chn, Len(chn) - 1, 1) & "拾" & Mid(chn, Len(chn), 1)
Case 6
chn = Mid(chn, Len(chn) - 5, 1) & "拾" & Mid(chn, Len(chn) - 4, 1) & "万" & Mid(chn, Len(chn) - 3, 1) & "仟" & Mid(chn, Len(chn) - 2, 1) & "佰" & Mid(chn, Len(chn) - 1, 1) & "拾" & Mid(chn, Len(chn), 1)
Case 7
chn = Mid(chn, Len(chn) - 6, 1) & "佰" & Mid(chn, Len(chn) - 5, 1) & "拾" & Mid(chn, Len(chn) - 4, 1) & "万" & Mid(chn, Len(chn) - 3, 1) & "仟" & Mid(chn, Len(chn) - 2, 1) & "佰" & Mid(chn, Len(chn) - 1, 1) & "拾" & Mid(chn, Len(chn), 1)
Case 8
chn = Mid(chn, Len(chn) - 7, 1) & "仟" & Mid(chn, Len(chn) - 6, 1) & "佰" & Mid(chn, Len(chn) - 5, 1) & "拾" & Mid(chn, Len(chn) - 4, 1) & "万" & Mid(chn, Len(chn) - 3, 1) & "仟" & Mid(chn, Len(chn) - 2, 1) & "佰" & Mid(chn, Len(chn) - 1, 1) & "拾" & Mid(chn, Len(chn), 1)
End Select
For i = 0 To Len(chn)
If InStr(i + 1, chn, "零", vbTextCompare) And InStr(i + 1, chn, "零", vbTextCompare) < Len(chn) Then
Select Case Mid(chn, InStr(i + 1, chn, "零", vbBinaryCompare) + 1, 1)
Case "拾"
Mid(chn, InStr(i + 1, chn, "零", vbBinaryCompare) + 1, 1) = Chr(0)
Case "佰"
Mid(chn, InStr(i + 1, chn, "零", vbBinaryCompare) + 1, 1) = Chr(0)
Case "仟"
Mid(chn, InStr(i + 1, chn, "零", vbBinaryCompare) + 1, 1) = Chr(0)
Case "万"
Mid(chn, InStr(i + 1, chn, "零", vbBinaryCompare), 1) = Chr(0)
Case Else
If Mid(chn, InStr(i + 1, chn, "零", vbBinaryCompare) + 2, 1) = "零" Then Mid(chn, InStr(i + 1, chn, "零", vbBinaryCompare), 1) = Chr(0)
End Select
Else
If Mid(chn, Len(chn), 1) = "零" And Len(chn) > 2 Then Mid(chn, Len(chn), 1) = Chr(0)
End If
Next
For i = 1 To Len(chn)
If Mid(chn, i, 1) <> Chr(0) Then chntmp = chntmp & Mid(chn, i, 1)
Next
'小数部分处理
chn = Right(Text1.Text, 2)
For i = 0 To 2 '整数部分处理
Select Case Mid(chn, i + 1, 1)
Case 0
chn = chn & "零"
Case 1
chn = chn & "壹"
Case 2
chn = chn & "贰"
Case 3
chn = chn & "叁"
Case 4
chn = chn & "肆"
Case 5
chn = chn & "伍"
Case 6
chn = chn & "陆"
Case 7
chn = chn & "柒"
Case 8
chn = chn & "捌"
Case 9
chn = chn & "玖"
End Select
Next
chn = Right(chn, 2)
chntmp = chntmp & "元" & Mid(chn, 1, 1) & "角" & Mid(chn, 2, 1) & "分"
MsgBox chntmp
End If
End Function

Private Sub Form_Load()
Me.Caption = "Code By:5653325"
Text1.Text = Format(0, "0.00")
End Sub

Private Sub Text1_Change()
If Len(Text1.Text) = 0 Then Text1.Text = 0
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub
水如烟 2006-12-20
  • 打赏
  • 举报
回复
我也写过一个,仅供参考:

货币金额拼写转换类
http://www.cnblogs.com/LzmTW/archive/2006/01/27/323884.html
alcome 2006-12-20
  • 打赏
  • 举报
回复
http://www.cnblogs.com/rand/archive/2006/05/08/393588.html
vbman2003 2006-12-20
  • 打赏
  • 举报
回复
上班中,忙里偷闲写的,想的可能不够周到
不过这个思路的好处是可以很容易的向更多位数扩展
vbman2003 2006-12-20
  • 打赏
  • 举报
回复
Function GetRMB(ByVal dMoney As Double) As String

Dim sPos() As String = {"分", "角", "元", "十", "百", "千", "万", "十", "百", "千", "亿"}
Dim sMoney As String = dMoney.ToString("F")

sMoney = sMoney.Replace("0", "零")
sMoney = sMoney.Replace("1", "壹")
sMoney = sMoney.Replace("2", "贰")
sMoney = sMoney.Replace("3", "叁")
sMoney = sMoney.Replace("4", "肆")
sMoney = sMoney.Replace("5", "伍")
sMoney = sMoney.Replace("6", "陆")
sMoney = sMoney.Replace("7", "柒")
sMoney = sMoney.Replace("8", "捌")
sMoney = sMoney.Replace("9", "玖")
sMoney = sMoney.Replace(".", String.Empty)

Dim sGetRMB As String = "整"
Dim j As Integer = 0
For i As Integer = sMoney.Length To 1 Step -1
sGetRMB = Mid(sMoney, i, 1) & sPos(j) & sGetRMB
j += 1
Next

Return sGetRMB

End Function
dlzhangln 2006-12-20
  • 打赏
  • 举报
回复
错了别找我,从前整理的,都没用过
dlzhangln 2006-12-20
  • 打赏
  • 举报
回复
赠送一个excel里的
=CONCATENATE(TEXT(INT(E29),"[DBNum2][$-804]G/通用格式"),"圆",TEXT(INT((E29-INT(E29))*10),"[DBNum2][$-804]G/通用格式"),"角",TEXT(INT((E29*10-INT(E29*10))*10+0.5),"[DBNum2][$-804]G/通用格式"),"分")
dlzhangln 2006-12-20
  • 打赏
  • 举报
回复
Public Function ConvertSum(ByVal str As String) As String
If Not IsPositveDecimal(str) Then Return "输入的不是正数字!"
If (Double.Parse(str) > 999999999999.99) Then Return "数字太大,无法换算,请输入一万亿元以下的金额"
Dim ch() As Char = New Char(1) {}
ch(0) = "."c '小数点
Dim splitstr() As String = Nothing '定义按小数点分割后的字符串数组
splitstr = str.Split(ch(0)) '按小数点分割字符串
If (splitstr.Length = 1) Then '只有整数部分
Return ConvertData(str) + "圆整"
Else '有小数部分
Dim rstr As String
rstr = ConvertData(splitstr(0)) + "圆" '转换整数部分
rstr += ConvertXiaoShu(splitstr(1)) '转换小数部分
Return rstr
End If
End Function

' 判断是否是正数字字符串
'判断字符串
' 如果是数字,返回true,否则返回false
Public Function IsPositveDecimal(ByVal str As String) As Boolean
Dim d As Decimal
Try
d = Decimal.Parse(Str)
Catch
Return False
End Try
If (d > 0) Then
Return True
Else
Return False
End If
End Function
'转换数字(整数)
' 需要转换的整数数字字符串
' 转换成中文大写后的字符串
Public Function ConvertData(ByVal str As String) As String
Dim tmpstr As String = ""
Dim rstr As String = ""
Dim strlen As Integer = str.Length
If strlen <= 4 Then '数字长度小于四位
rstr = ConvertDigit(str)
Else
If strlen <= 8 Then '数字长度大于四位,小于八位
tmpstr = str.Substring(strlen - 4, 4) '先截取最后四位数字
rstr = ConvertDigit(tmpstr) '转换最后四位数字
tmpstr = str.Substring(0, strlen - 4) '截取其余数字
'将两次转换的数字加上萬后相连接
rstr = String.Concat(ConvertDigit(tmpstr) + "萬", rstr)
rstr = rstr.Replace("零萬", "萬")
rstr = rstr.Replace("零零", "零")
Else
If (strlen <= 12) Then '数字长度大于八位,小于十二位

tmpstr = str.Substring(strlen - 4, 4) '先截取最后四位数字
rstr = ConvertDigit(tmpstr) '转换最后四位数字
tmpstr = str.Substring(strlen - 8, 4) '再截取四位数字
rstr = String.Concat(ConvertDigit(tmpstr) + "萬", rstr)
tmpstr = str.Substring(0, strlen - 8)
rstr = String.Concat(ConvertDigit(tmpstr) + "億", rstr)
rstr = rstr.Replace("零億", "億")
rstr = rstr.Replace("零萬", "零")
rstr = rstr.Replace("零零", "零")
rstr = rstr.Replace("零零", "零")
End If
End If
End If
strlen = rstr.Length
If strlen >= 2 Then
Select Case rstr.Substring(strlen - 2, 2)
Case "佰零"
rstr = rstr.Substring(0, strlen - 2) + "佰"
Case "仟零"
rstr = rstr.Substring(0, strlen - 2) + "仟"
Case ("萬零")
rstr = rstr.Substring(0, strlen - 2) + "萬"
Case "億零"
rstr = rstr.Substring(0, strlen - 2) + "億"
End Select
End If
Return rstr
End Function
'转换数字(小数部分)
'需要转换的小数部分数字字符串
'转换成中文大写后的字符串
Public Function ConvertXiaoShu(ByVal str As String) As String
Dim strlen As Integer = str.Length
Dim rstr As String
If strlen = 1 Then
rstr = ConvertChinese(str) + "角"
Return rstr
Else
Dim tmpstr As String = str.Substring(0, 1)
rstr = ConvertChinese(tmpstr) + "角"
tmpstr = str.Substring(1, 1)
rstr += ConvertChinese(tmpstr) + "分"
rstr = rstr.Replace("零分", "")
rstr = rstr.Replace("零角", "")
Return rstr
End If
End Function
'转换数字
'转换的字符串(四位以内)
Public Function ConvertDigit(ByVal str As String) As String
Dim strlen As Integer = str.Length
Dim rstr As String = ""
Select Case strlen
Case 1
rstr = ConvertChinese(str)
Case 2
rstr = Convert2Digit(str)
Case 3
rstr = Convert3Digit(str)
Case 4
rstr = Convert4Digit(str)
End Select
rstr = rstr.Replace("拾零", "拾")
strlen = rstr.Length
Return rstr
End Function
'转换四位数字
Public Function Convert4Digit(ByVal str As String) As String
Dim str1 As String = str.Substring(0, 1)
Dim str2 As String = str.Substring(1, 1)
Dim str3 As String = str.Substring(2, 1)
Dim str4 As String = str.Substring(3, 1)
Dim rstring As String = ""
rstring += ConvertChinese(str1) + "仟"
rstring += ConvertChinese(str2) + "佰"
rstring += ConvertChinese(str3) + "拾"
rstring += ConvertChinese(str4)
rstring = rstring.Replace("零仟", "零")
rstring = rstring.Replace("零佰", "零")
rstring = rstring.Replace("零拾", "零")
rstring = rstring.Replace("零零", "零")
rstring = rstring.Replace("零零", "零")
rstring = rstring.Replace("零零", "零")
Return rstring
End Function
' 转换三位数字
Public Function Convert3Digit(ByVal str As String) As String
Dim str1 As String = str.Substring(0, 1)
Dim str2 As String = str.Substring(1, 1)
Dim str3 As String = str.Substring(2, 1)
Dim rstring As String = ""
rstring += ConvertChinese(str1) + "佰"
rstring += ConvertChinese(str2) + "拾"
rstring += ConvertChinese(str3)
rstring = rstring.Replace("零佰", "零")
rstring = rstring.Replace("零拾", "零")
rstring = rstring.Replace("零零", "零")
rstring = rstring.Replace("零零", "零")
Return rstring
End Function
'转换二位数字
Public Function Convert2Digit(ByVal str As String) As String
Dim str1 As String = str.Substring(0, 1)
Dim str2 As String = str.Substring(1, 1)
Dim rstring As String = ""
rstring += ConvertChinese(str1) + "拾"
rstring += ConvertChinese(str2)
rstring = rstring.Replace("零拾", "零")
rstring = rstring.Replace("零零", "零")
Return rstring
End Function
'将一位数字转换成中文大写数字
Public Function ConvertChinese(ByVal str As String) As String
'"零壹贰叁肆伍陆柒捌玖拾佰仟萬億圆整角分"
Dim ccstr As String = ""
Select Case str
Case "0"
ccstr = "零"
Case "1"
ccstr = "壹"
Case "2"
ccstr = "贰"
Case "3"
ccstr = "叁"
Case "4"
ccstr = "肆"
Case "5"
ccstr = "伍"
Case "6"
ccstr = "陆"
Case "7"
ccstr = "柒"
Case "8"
ccstr = "捌"
Case "9"
ccstr = "玖"
End Select
Return (ccstr)
End Function
End Class


fsqman 2006-12-20
  • 打赏
  • 举报
回复
我要 VB 的啊!!!!!!!!!!
九斤半 2006-12-20
  • 打赏
  • 举报
回复
SQL中的方法:

http://community.csdn.net/Expert/topic/5026/5026068.xml?temp=.999325

vbman2003 2006-12-20
  • 打赏
  • 举报
回复
不是难题
只是算法好坏问题
huazi4995 2006-12-20
  • 打赏
  • 举报
回复
http://www.cnblogs.com/huazi4995/articles/546791.html

16,549

社区成员

发帖
与我相关
我的任务
社区描述
VB技术相关讨论,主要为经典vb,即VB6.0
社区管理员
  • VB.NET
  • 水哥阿乐
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧