请看附件，如何将数字5678转换成伍千陆佰柒拾捌，请指教，急用，先谢过了！！！
请看附件，如何将数字5678转换成伍千陆佰柒拾捌，请指教，急用，先谢过了 --------------------编程问答-------------------- 就是让text2.text 显示伍千陆佰柒拾捌,请详细些,学习了,在线等！ --------------------编程问答-------------------- http://topic.csdn.net/t/20011031/11/349290.html# --------------------编程问答-------------------- 我是楼主，高手能针对我的这个附件给出一段马上生效的代码吗，多谢了！ --------------------编程问答-------------------- 终级帖子：数字转换大写,不是金额转换，是易做图数字转换为大写,含小数位
http://topic.csdn.net/u/20070112/12/8fb50b83-45bf-4ccf-90c8-a122233a3fc2.html
人民币大写转换的问题
http://topic.csdn.net/u/20070612/11/978ef34b-8e6b-4d87-b397-13e15ea62ad3.html --------------------编程问答-------------------- Private Sub Command1_Click()
Text2.Text = ""
Text2.Text = GetChinaMoney(Text1.Text)
End Sub
Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text1.Text = "5678"
End Sub
Public Function GetChinaMoney(ByVal strNumber) As String
Dim a() As String
Dim s1 As String, s2 As String
Dim l1 As String
Dim s3 As String
Dim strEng As String
strEng2Ch = "零壹贰叁肆伍陆柒捌玖"
If Not IsNumeric(strNumber) Then
If Trim(strNumber) <> "" Then MsgBox "无效的数字"
GetChinaMoney = ""
Exit Function
End If
l1 = InStr(strNumber, ".")
If l1 <> 0 Then
s1 = Left(strNumber, l1 - 1)
s2 = Mid(strNumber, l1 + 1)
Else
s1 = strNumber
s2 = "0"
End If
s1 = Dig2Chinese_pb(s1)
s3 = ""
If s2 <> 0 Then
For i = 1 To Len(s2)
If i = 1 Then s3 = s3 & Mid(strEng2Ch, Val(Mid(s2, i, 1)) + 1, 1) & "角"
If i = 2 Then s3 = s3 & Mid(strEng2Ch, Val(Mid(s2, i, 1)) + 1, 1) & "分"
If i = 3 Then s3 = s3 & Mid(strEng2Ch, Val(Mid(s2, i, 1)) + 1, 1) & "厘"
If i = 4 Then s3 = s3 & Mid(strEng2Ch, Val(Mid(s2, i, 1)) + 1, 1) & "毫"
Next
End If
GetChinaMoney = s1 & "圆" & s3
End Function
Public Function Dig2Chinese_pb(strEng As String) As String
Dim intLen As Integer, intCounter As Integer
Dim strCh As String, strtempCh As String
Dim strSeqCh1 As String, strSeqCh2 As String
Dim strEng2Ch As String
Dim sTemp As String
Dim i As Integer
Dim iWanBit As Integer
Dim iYiBit As Integer
Dim iWanYiBit As Integer
Dim sFoward As String
iWanBit = 0: iYiBit = 0: iWanYiBit = 0
sFoward = StrReverse(strEng)
For i = 1 To Len(sFoward)
Dim val1 As Long
val1 = Val(Mid(sFoward, i, 1))
If i >= 5 And i <= 8 Then
If iWanBit = 0 Then
If val1 <> 0 Then iWanBit = i
End If
End If
If i >= 9 And i <= 12 Then
If iYiBit = 0 Then
If val1 <> 0 Then iYiBit = i
End If
End If
If i >= 13 And i <= 16 Then
If iWanYiBit = 0 Then
If val1 <> 0 Then iWanYiBit = i
End If
End If
Next
If Not IsNumeric(strEng) Then
If Trim(strEng) <> "" Then MsgBox "无效的数字"
Dig2Chinese_pb = ""
Exit Function
End If
If Len(strEng) > 15 Then
MsgBox "数字位数太长"
Dig2Chinese_pb = ""
Exit Function
End If
strEng2Ch = "零壹贰叁肆伍陆柒捌玖"
strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
strSeqCh2 = " 万亿兆"
'转换为表示数值的字符串
strEng = CStr(CDec(strEng))
'len
intLen = Len(strEng)
'change to chinese
For intCounter = 1 To intLen
strtempCh = Mid(strEng2Ch, Val(Mid(strEng, intCounter, 1)) + 1, 1)
If strtempCh = "零" And intLen <> 1 Then
' If Mid(strEng, intCounter + 1, 1) = "0" Or (intLen - intCounter + 1) Mod 4 = 1 Then
'若之后一个也是零，或在最后，则不显示"零"
If Mid(strEng, intCounter + 1, 1) = "0" Or intCounter = intLen Then
strtempCh = ""
End If
Else
'添加位 拾佰仟
If strtempCh <> "零" Then strtempCh = strtempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))
End If
'添加位 "万"(5-8),"亿"(9-12),"万亿"(13-16)
' iWanBit = 0: iYiBit = 0: iWanYiBit = 0
If intCounter = Len(strEng) + 1 - iWanBit Then strtempCh = strtempCh & "万"
If intCounter = Len(strEng) + 1 - iYiBit Then strtempCh = strtempCh & "亿"
If intCounter = Len(strEng) + 1 - iWanYiBit Then strtempCh = strtempCh & "万亿"
'组成汉字
strCh = strCh & Trim(strtempCh)
Next
Dig2Chinese_pb = strCh
End Function
--------------------编程问答-------------------- 学习中，很有帮助啊！ --------------------编程问答-------------------- 貌似CSDN 字符串中加空格的问题还存在呀 --------------------编程问答-------------------- xuexi --------------------编程问答-------------------- 我也发发！好久不来VB版了，嘎嘎
使用N年的代码
'*******************************************************************
'** **
'** 8、小写金额转换大写 **
'** **
'*******************************************************************
'1、函数功能：小写金额转换大写
'2、参数解释：s_strMoney(小写金额)
'3、返 回 值：String型
'4、调用示例：call qh_ChangeMoney("8888")
Public Function qh_ChangeMoney(s_strMoney As String) As String
Dim l_f_money_unit, l_f, l_f_money, l_f_unit, l_f_badge As String
Dim l_f_long, l_f_i As Long
l_f_money = Format(Trim(Round(s_strMoney, 2)), "0.00")
l_f_long = Len(l_f_money)
For l_f_i = 1 To l_f_long
l_f_unit = Right(l_f_money, l_f_i)
l_f_unit = Left(l_f_unit, 1)
If l_f_unit <> "." Then
Select Case l_f_unit
Case "0"
l_f_unit = "零"
Case "1"
l_f_unit = "壹"
Case "2"
l_f_unit = "贰"
Case "3"
l_f_unit = "叁"
Case "4"
l_f_unit = "肆"
Case "5"
l_f_unit = "伍"
Case "6"
l_f_unit = "陆"
Case "7"
l_f_unit = "柒"
Case "8"
l_f_unit = "捌"
Case "9"
l_f_unit = "玖"
End Select
Select Case l_f_i
Case 1
l_f_badge = "分"
Case 2
l_f_badge = "角"
Case 3
l_f_badge = "元"
Case 4
l_f_badge = "元"
Case 5
l_f_badge = "拾"
Case 6
l_f_badge = "佰"
Case 7
l_f_badge = "仟"
Case 8
l_f_badge = "万"
Case 9
l_f_badge = "拾"
Case 10
l_f_badge = "佰"
Case 11
l_f_badge = "仟"
Case 12
l_f_badge = "亿"
Case 13
l_f_badge = "拾"
Case 14
l_f_badge = "佰"
Case 15
l_f_badge = "仟"
End Select
l_f_money_unit = l_f_unit + l_f_badge + l_f_money_unit
End If
Next l_f_i
l_f_money_unit = Replace(l_f_money_unit, "零分", "零")
l_f_money_unit = Replace(l_f_money_unit, "零角", "零")
l_f_money_unit = Replace(l_f_money_unit, "零元", "元")
l_f_money_unit = Replace(l_f_money_unit, "零拾", "零")
l_f_money_unit = Replace(l_f_money_unit, "零佰", "零")
l_f_money_unit = Replace(l_f_money_unit, "零仟", "零")
l_f_money_unit = Replace(l_f_money_unit, "零万", "万")
l_f_money_unit = Replace(l_f_money_unit, "零亿", "亿")
Do
If InStr(1, l_f_money_unit, "零零") <> 0 Then
l_f_money_unit = Replace(l_f_money_unit, "零零", "零")
Else
Exit Do
End If
Loop
l_f_money_unit = Replace(l_f_money_unit, "零元", "元")
l_f_money_unit = Replace(l_f_money_unit, "零万", "万")
l_f_money_unit = Replace(l_f_money_unit, "零亿", "亿")
l_f_money_unit = Replace(l_f_money_unit, "亿万", "亿")
Do
If Right(l_f_money_unit, 1) = "零" Then
l_f_money_unit = Left(l_f_money_unit, Len(l_f_money_unit) - 1)
Else
Exit Do
End If
Loop
qh_ChangeMoney = l_f_money_unit & IIf(InStr(1, l_f_money_unit, "分") <> 0, "", "整")
End Function
补充：VB , 基础类
