求助:将数字转化成汉字大写的函数

[bluelang]

例如125001-->拾贰伍仟零壹

[zhenxizhou]

留下EMAIL，我发给你。

[bluelang]

[e-mail] or [e-mail] 谢谢大虾了

[lihonggen0]

'*********************************************************
'* 名称：nNumber2Chinese
'* 功能：数值转换为人民币(汉字)
'* 用法：nNumber2Chinese(数值)
'*********************************************************
Public Function Num2Chi(txtJE As Double) As String
Dim I, K As Integer
Dim NC, nd, ka, chrNum, strZheng As String
Dim c1, c2, c3 As String
Dim K1 As Integer
Dim Zheng As String
Dim Xiao As String
NC = Trim(Format(txtJE, "##0.00"))
c1 = "仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"
c2 = "角分"
c3 = "玖捌柒陆伍肆叁贰壹"
If NC = 0 Then
Num2Chi = "零元整"
Exit Function
End If
Num2Chi = ""
Zheng = Mid(NC, 1, (Len(NC) - 3))
Xiao = Mid(NC, (Len(Zheng) + 2))
If Val(Xiao) <> 0 Then
For I = Len(Xiao) To 1 Step -1
chrNum = Mid(Xiao, I, 1)
If chrNum <> 0 Then
Num2Chi = Mid(c2, I, 1) & Num2Chi
Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
End If
Next I
End If

K = 0
If Val(Zheng) <> 0 Then
Num2Chi = "元" & Num2Chi
For I = Len(Zheng) To 1 Step -1
If (Len(Zheng) - I) = 4 Then
Num2Chi = "万" & Num2Chi
ElseIf (Len(Zheng) - I) = 8 Then
Num2Chi = "亿" & Num2Chi
ElseIf (Len(Zheng) - I) = 12 Then
Num2Chi = "万" & Num2Chi
End If
chrNum = Mid(Zheng, I, 1)
If chrNum <> 0 Then
If I = Len(Zheng) Then
Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
Else
If (Len(Zheng) - I) <> 4 And (Len(Zheng) - I) <> 8 And (Len(Zheng) - I) <> 12 Then
Num2Chi = Mid(c1, (Len(c1) - K), 1) & Num2Chi
End If
Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
End If
Else
If Mid(Num2Chi, 1, 1) <> "元" And Mid(Num2Chi, 1, 1) <> "万" And Mid(Num2Chi, 1, 1) <> "亿" Then
If Mid(Num2Chi, 1, 1) <> "零" Then
Num2Chi = "零" & Num2Chi
End If
End If
End If
K = K + 1
Next I
End If
If Right(Trim(Num2Chi), 1) <> "分" Then
Num2Chi = Num2Chi & "整"
End If
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

[xiaoxinghappy]

已前已经有很多人问过了，search.csdn.net 查找一下

[Sean918]

这个...一共才10个数字,自己写个函数不是很难吧

难道有有现成的函数?

[用户 昵称]

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

[Sean918]

Private Sub Form_Load()
Dim sNumber As String
sNumber = Trim(InputBox("请输入数字:", "输入阿拉伯数字", ""))
If IsNumeric(sNumber) Then
Me.AutoRedraw = True
Me.Print "原数字为:" + sNumber + " 中文大写为: " + NumChange(sNumber)
Else
MsgBox "输入数字有误!"
End
End If
End Sub

Private Function NumChange(ByVal sNum As String) As String
Dim i As Integer
For i = 1 To Len(sNum)
Select Case Val(Mid(sNum, i, 1))
Case 0
NumChange = NumChange + "零"
Case 1
NumChange = NumChange + "壹"
Case 2
NumChange = NumChange + "贰"
Case 3
NumChange = NumChange + "叁"
Case 4
NumChange = NumChange + "肆"
Case 5
NumChange = NumChange + "伍"
Case 6
NumChange = NumChange + "陆"
Case 7
NumChange = NumChange + "柒"
Case 8
NumChange = NumChange + "捌"
Case 9
NumChange = NumChange + "玖"
End Select
DoEvents
Next
NumChange = Trim(NumChange)
End Function