求助，汉字金额转换程序

[wfish]

就是将数字转换成大写金额的程序如102为一百零贰元正，15.23为十五元贰角三分
希望各位能帮帮我，如有现成的程序或函数，能否发给我，谢谢！
偶的邮箱：[e-mail]

[fraser01]

请你查找1年前的我发的帖子，是关于金额转换的，共用了30行不到的代码可以解决！
我不想在重新做一次了。

[用户 昵称]

' 本模块生成汉字大写的金额
'
Option Explicit
' 名称： CCh
' 得到一位数字 N1 的汉字大写
' 0 返回 ""
Private Function CCh(N1) As String
Select Case N1
Case 0
CCh = "零"
Case 1
CCh = "壹"
Case 2
CCh = "贰"
Case 3
CCh = "叁"
Case 4
CCh = "肆"
Case 5
CCh = "伍"
Case 6
CCh = "陆"
Case 7
CCh = "柒"
Case 8
CCh = "捌"
Case 9
CCh = "玖"
End Select
End Function
'名称： ChMoney
' 得到数字 N1 的汉字大写
' 最大为 千万位
' O 返回 ""
Public Function ChMoney(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn '小数位置
Dim ST1 As String
Dim T1 As String
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '1000 以内
Dim s3 As String '10000



If N1 = 0 Then
ChMoney = " "
Exit Function
End If
If N1 < 0 Then
ChMoney = "负" + ChMoney(Abs(N1))
Exit Function
End If
tMoney = Trim(Str(N1))
tn = InStr(tMoney, ".") '小数位置
s1 = ""
If tn <> 0 Then
ST1 = Right(tMoney, Len(tMoney) - tn)
If ST1 <> "" Then
T1 = Left(ST1, 1)
ST1 = Right(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s1 = s1 + CCh(Val(T1)) + "角"
End If
If ST1 <> "" Then
T1 = Left(ST1, 1)
s1 = s1 + CCh(Val(T1)) + "分"
End If
End If
ST1 = Left(tMoney, tn - 1)
Else
ST1 = tMoney
End If

s2 = ""
If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s2 = CCh(Val(T1)) + s2
End If

If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s2 = CCh(Val(T1)) + "拾" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If

If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s2 = CCh(Val(T1)) + "佰" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If

If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s2 = CCh(Val(T1)) + "仟" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If

s3 = ""
If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s3 = CCh(Val(T1)) + s3
End If


If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s3 = CCh(Val(T1)) + "拾" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If

If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s3 = CCh(Val(T1)) + "佰" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If

If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s3 = CCh(Val(T1)) + "仟" + s3
End If
End If
If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)

If Len(s3) > 0 Then

If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
s3 = s3 & "万"
End If

ChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元整" & s1)
End Function

[用户 昵称]

'入口：Money 金额
'出口：大写金额
Public Function MoneyToChinese(Money As Double) As String
Dim i As Long
Dim mstrSource As String

If Money = 0 Then MoneyToChinese = vbNullString: Exit Function
mstrSource = Format(CStr(Abs(Money)), "#0.00")
i = InStr(1, mstrSource, ".")
If i > 0 Then mstrSource = Mid(mstrSource, 1, i - 1) + Mid(mstrSource, i + 1, Len(mstrSource) - i)
If Left(mstrSource, 1) = "0" Then mstrSource = Mid(mstrSource, 2, Len(mstrSource) - 1)

mstrSource = NumstrToChinese(mstrSource)
If Len(Trim(mstrSource)) = 0 Then MoneyToChinese = vbNullString: Exit Function
If Money < 0 Then mstrSource = Trim("A") & Trim(mstrSource) '负

For i = 1 To Len(mstrSource)
Select Case Mid(mstrSource, i, 1)
Case "0"
MoneyToChinese = MoneyToChinese + "零"
Case "1"
MoneyToChinese = MoneyToChinese + "壹"
Case "2"
MoneyToChinese = MoneyToChinese + "贰"
Case "3"
MoneyToChinese = MoneyToChinese + "叁"
Case "4"
MoneyToChinese = MoneyToChinese + "肆"
Case "5"
MoneyToChinese = MoneyToChinese + "伍"
Case "6"
MoneyToChinese = MoneyToChinese + "陆"
Case "7"
MoneyToChinese = MoneyToChinese + "柒"
Case "8"
MoneyToChinese = MoneyToChinese + "捌"
Case "9"
MoneyToChinese = MoneyToChinese + "玖"
Case "M"
MoneyToChinese = MoneyToChinese + "亿"
Case "W"
MoneyToChinese = MoneyToChinese + "万"
Case "S"
MoneyToChinese = MoneyToChinese + "仟"
Case "H"
MoneyToChinese = MoneyToChinese + "佰"
Case "T"
MoneyToChinese = MoneyToChinese + "拾"
Case "Y"
MoneyToChinese = MoneyToChinese + "圆"
Case "J"
MoneyToChinese = MoneyToChinese + "角"
Case "F"
MoneyToChinese = MoneyToChinese + "分"
Case "A"
MoneyToChinese = MoneyToChinese + "负"
End Select
Next i
If Right(Trim(MoneyToChinese), 1) <> "分" Then MoneyToChinese = MoneyToChinese + "整"
End Function

[用户 昵称]

'4.金额转换，大写--〉小写！！
Private Function NumstrToChinese(numstr As String) As String
Dim i As Integer, j As Integer
Dim mstrChar As String
Dim mstrFlag(4) As String
Dim mblnAddzero As Boolean

On Error Resume Next
mstrFlag(0) = Trim("")
mstrFlag(1) = Trim("T")
mstrFlag(2) = Trim("H")
mstrFlag(3) = Trim("S")

For i = 1 To Len(numstr)
j = Len(numstr) - i
mstrChar = Mid(numstr, i, 1)
If mstrChar <> "0" And j > 1 Then NumstrToChinese = NumstrToChinese + mstrChar + mstrFlag((j - 2) Mod 4)
If mstrChar = "0" And mblnAddzero = False Then
NumstrToChinese = NumstrToChinese + Trim("0")
mblnAddzero = True
End If
If j = 14 Then NumstrToChinese = NumstrToChinese + Trim("W")
If j = 2 Then
If Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "0" Then
NumstrToChinese = Mid(NumstrToChinese, 1, Len(NumstrToChinese) - 1) + "Y0"
Else
NumstrToChinese = NumstrToChinese + "Y" '元
End If
End If
If j = 6 Then
If Len(NumstrToChinese) > 2 Then
If Mid(NumstrToChinese, Len(NumstrToChinese) - 1, 2) = "M0" Then GoTo 10
End If
If Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "0" Then
NumstrToChinese = Mid(NumstrToChinese, 1, Len(NumstrToChinese) - 1) + "W0"
Else
NumstrToChinese = NumstrToChinese + "W"
End If
End If
10:
If j = 10 Then
If Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "0" Then
NumstrToChinese = Mid(NumstrToChinese, 1, Len(NumstrToChinese) - 1) + "M0"
Else
NumstrToChinese = NumstrToChinese + "M" '亿
End If
End If
If j = 0 And mstrChar <> "0" Then NumstrToChinese = NumstrToChinese + mstrChar + "F"
If j = 1 And mstrChar <> "0" Then NumstrToChinese = NumstrToChinese + mstrChar + "J"
If mstrChar <> "0" Then mblnAddzero = False
Next i
If Mid(NumstrToChinese, 1, 1) = "1" And Mid(NumstrToChinese, 2, 1) = mstrFlag(1) Then NumstrToChinese = Mid(NumstrToChinese, 2, Len(NumstrToChinese) - 1)
If Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "0" Then NumstrToChinese = Mid(NumstrToChinese, 1, Len(NumstrToChinese) - 1)
If Mid(NumstrToChinese, 1, 1) = "0" Then NumstrToChinese = Mid(NumstrToChinese, 2, Len(NumstrToChinese) - 1)
If Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "M" Or Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "W" Or Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "S" Or Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "H" Or Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "T" Then NumstrToChinese = NumstrToChinese + Trim("Y")
End Function

--------------------------------








不想再贴了。精华区就有

[mndsoft]

'参数一为数字
'参数二为是不是反回人民币大写
'参数三为是不是直接读数字，否则带有十百等单位
'参数四为设置小数点后面的位数，默认为4
'使用方法是
't = GetChinaNum(20005.000436, , , 7) '返回 “二千零五点零零零四三六”
't = GetChinaNum(2005.436, True, , 7) '返回“贰仟零伍元肆角肆分”
't = GetChinaNum(2005.436, , True, 7) '返加“二零零五点四三六”

Public Function GetChinaNum(otherNum As Double, Optional isRMB As Boolean, Optional numOption As Boolean, Optional dotNum As Integer) As String
On Error Resume Next
Dim i As Integer, bstr As Integer
Dim num As String, numwei As String, numshu As String, numrmb As String
num = Trim(Str(Int(otherNum)))

If isRMB Then
numwei = "拾佰仟万拾佰仟亿拾佰仟"
numshu = "零壹贰叁肆伍陆柒捌玖拾"
Else
numwei = "十百千万十百千亿十百千"
numshu = "零壹贰叁肆伍陆柒捌玖拾" ' "零一二三四五六七八九十"
End If
If otherNum < 20 And otherNum >= 10 Then
num = Right(num, 1)
GetChinaNum = Left(numwei, 1)
End If
For i = 1 To Len(num)
bstr = Mid(num, i, 1)
If numOption Then
GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1)

Else
GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1)
If bstr = "0" Then
If Mid(numwei, Len(num) - i, 1) = "万" Or Mid(numwei, Len(num) - i, 1) = "亿" Then
Do While Right(GetChinaNum, 1) = "零"
GetChinaNum = Left(GetChinaNum, Len(GetChinaNum) - 1)
Loop
GetChinaNum = GetChinaNum + Mid(numwei, Len(num) - i, 1)
End If

Else

GetChinaNum = GetChinaNum + Mid(numwei, Len(num) - i, 1)
End If
GetChinaNum = Replace(GetChinaNum, "零零", "零")
End If
Next i
If numOption = False Then
Do While Right(GetChinaNum, 1) = "零"
GetChinaNum = Left(GetChinaNum, Len(GetChinaNum) - 1)
Loop
End If
If isRMB Then
numrmb = "元角分"
GetChinaNum = GetChinaNum + Mid(numrmb, 1, 1)
If Val(num) <> otherNum Then
num = Trim(Str(Round(otherNum - Val(num), 2)))
For i = 2 To Len(num)
bstr = Mid(num, i, 1)
GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1) + Mid(numrmb, i, 1)
Next i
Else
GetChinaNum = GetChinaNum + "整"
End If
Else
If Val(num) <> otherNum Then
If dotNum = 0 Then dotNum = 4
num = Trim(CStr(Round(otherNum - Val(num), dotNum)))
If GetChinaNum = "" Then GetChinaNum = "零"
GetChinaNum = GetChinaNum ' + "点"
For i = 2 To Len(num)
bstr = Mid(num, i, 1)
GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1)
Next i
End If
End If
End Function

[lihonggen0]

dim chap(21, 1)
初始化：

chap(0, 0) = "万": chap(0, 1) = 10000
chap(1, 0) = "仟": chap(1, 1) = 1000
chap(2, 0) = "佰": chap(2, 1) = 100
chap(3, 0) = "拾": chap(3, 1) = 10
chap(4, 0) = "元": chap(4, 1) = 1
chap(5, 0) = "角": chap(5, 1) = 0.1
chap(6, 0) = "分": chap(6, 1) = 0.01
chap(11, 0) = "壹": chap(11, 1) = 1
chap(12, 0) = "贰": chap(12, 1) = 2
chap(13, 0) = "叁": chap(13, 1) = 3
chap(14, 0) = "肆": chap(14, 1) = 4
chap(15, 0) = "伍": chap(15, 1) = 5
chap(16, 0) = "陆": chap(16, 1) = 6
chap(17, 0) = "柒": chap(17, 1) = 7
chap(18, 0) = "捌": chap(18, 1) = 8
chap(19, 0) = "玖": chap(19, 1) = 9
chap(20, 0) = "零": chap(20, 1) = 0
chap(21, 0) = "亿": chap(21, 1) = 100000000

function subtochinese(price as integer)
'转化千百十
dim i as integer
dim num(15) as integer
i = 1
do until price = 0
num(i) = int(price / chap(i, 1))
if num(i) <> 0 then
subtochinese = subtochinese & chap(num(i) + 10, 0) & chap(i, 0)
price = price - num(i) * chap(i, 1)
else
if subtochinese <> "" and right(subtochinese, 1) <> "零" then
subtochinese = subtochinese & "零"
end if
end if
i = i + 1
loop
if right(subtochinese, 1) = "元" then
subtochinese = left(subtochinese, len(subtochinese) - 1)
end if
end function

function pricetochinese(price as double)
if price >= 100000000 then '大于1亿
pricetochinese = pricetochinese & pricetochinese(int(price / 100000000)) & "亿"
price = price - int(price / 100000000) * 100000000
end if
if price >= 10000 then
pricetochinese = pricetochinese & subtochinese(int(price / 10000)) & "万"
price = price - int(price / 10000) * 10000
end if
if int(price) <> 0 then '如果万与千间无数，则应添零
if pricetochinese <> "" and int(price) < 1000 then
pricetochinese = pricetochinese & "零"
end if
pricetochinese = pricetochinese & subtochinese(int(price))
price = price - int(price)
end if
if pricetochinese <> "" then pricetochinese = pricetochinese & "元"
if price = 0 then '到元为止
pricetochinese = pricetochinese & "整"
else
price = int(price * 100)
if int(price / 10) <> 0 then
pricetochinese = pricetochinese & chap(int(price / 10) + 10, 0) & "角"
price = price - int(price / 10) * 10
end if
if price <> 0 then
pricetochinese = pricetochinese & chap(int(price) + 10, 0) & "分"

end if
end if
end function
调用时：pricetochinese(123432435.345)

[fraser01]

http://expert.csdn.net/Expert/topic/431/431983.xml?temp=.2501032
绝对好的连结

[wfish]

多谢大家了：）。

[chenyu5188]

来晚了。UP

[wfish]

呵呵，来者有份，偶要结贴了，最后再次谢谢版友的热心帮助和指导，谢谢大家！！！

[wfish]

在线等候ing~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[lanboy]

我发给你吧