请问，如何将数字转化问人民币大写，谢谢

Question

请问，我想将一个数字转换为人民币大写，请各位大虾指点，谢谢

Answer 1

' 本模块生成汉字大写的金额
' 由   Ken Jin   制作
'      VB 加油站 提供
'      vbtt.yeah.net
' 名称： 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 s1 As String '临时STRING 小数部分
Dim s2 As String '1000 以内
Dim s3 As String '10000If 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 IfIf 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 IfIf 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 IfIf 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 Ifs3 = ""
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 IfIf 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 IfIf 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
If s1 = "" Then s1 = "整"
ChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元" & s1)End Function

Answer 2

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 FunctionPublic Function CNulls( _
    ByVal v As Variant, _
    ByVal DefaultValue As Variant) As Variant
    
    ' determine if it is "Null"
    Dim bIsNull As Boolean, t As VbVarType
    t = VarType(v)
    If t = vbObject Then
        bIsNull = v Is Nothing
    Else
        bIsNull = IsEmpty(v) Or IsNull(v)
        If t = vbString Then
            bIsNull = bIsNull Or v = vbNullString
        ElseIf t > vbArray Then
            bIsNull = bIsNull Or (LBound(v) = UBound(v))
        End If
    End If
    
    If bIsNull Then
        If Not IsMissing(DefaultValue) Then
            CNulls = DefaultValue
        Else
            Select Case t
            Case vbString
                CNulls = vbNullString
            Case vbLong             ' list seprately for getting more performance
                CNulls = 0
            Case vbInteger
                CNulls = 0
            Case vbDouble
                CNulls = 0
            Case vbBoolean
                CNulls = False
            Case vbByte, vbCurrency, vbDecimal, vbDouble, _
                 vbError, vbSingle
                CNulls = 0
            Case vbDate
                CNulls = Now
            Case Else
                CNulls = Null
            End Select
        End If
    Else
        CNulls = v
    End If
End Function

Answer 3

以前写的：
Function daxie(money As String) As String '
Dim x As String, y As String
Const zimu = ".sbqwsbqysbqwsbq" '定义位置代码
Const letter = "0123456789sbqwy.zjf" '定义汉字缩写
Const upcase = "零壹贰叁肆伍陆柒捌玖拾佰仟萬億圆整角分" '定义大写汉字
Dim temp As String
temp = money
If InStr(temp, ".") > 0 Then temp = Left(temp, InStr(temp, ".") - 1)If Len(temp) > 16 Then MsgBox "数目太大，无法换算！请输入一亿亿以下的数字", 64, "错误提示": Exit Function '只能转换一亿亿元以下数目的货币！x = Format(money, "0.00") '格式化货币
y = ""
For i = 1 To Len(x) - 3
y = y & Mid(x, i, 1) & Mid(zimu, Len(x) - 2 - i, 1)
Next
If Right(x, 3) = ".00" Then
y = y & "z"          '***元整
Else
 y = y & Left(Right(x, 2), 1) & "j" & Right(x, 1) & "f"     '*元*角*分
 End If
y = Replace(y, "0q", "0") '避免零千(如：40200肆萬零千零贰佰)
y = Replace(y, "0b", "0") '避免零百(如：41000肆萬壹千零佰)
y = Replace(y, "0s", "0") '避免零十(如：204贰佰零拾零肆)Do While y <> Replace(y, "00", "0")
y = Replace(y, "00", "0") '避免双零(如：1004壹仟零零肆)
Loop
y = Replace(y, "0y", "y") '避免零億(如：210億     贰佰壹十零億)
y = Replace(y, "0w", "w") '避免零萬(如：210萬     贰佰壹十零萬)
y = IIf(Len(x) = 5 And Left(y, 1) = "1", Right(y, Len(y) - 1), y) '避免壹十(如：14壹拾肆；10壹拾)
y = IIf(Len(x) = 4, Replace(y, "0.", ""), Replace(y, "0.", ".")) '避免零元(如：20.00贰拾零圆；0.12零圆壹角贰分)For i = 1 To 19
y = Replace(y, Mid(letter, i, 1), Mid(upcase, i, 1)) '大写汉字
Next
daxie = y
End FunctionPrivate Sub Command1_Click()
MsgBox daxie("1218212212309322.3238")
End Sub

Answer 4

'人民币大小写转换函数,不能转换大于9999999.99的数
Public Function MoneyToUper(dblMoney As Double) As String
  Dim intKey As Integer            '字符位数
  Dim strOut As String
  Dim strOut1 As String
  Dim strOut2 As String
  Dim blnMark As Boolean           '正负标记
  Dim dblTemp As Double
  Dim lngSpot As Double            '角分标志
  Const strNumic As String = "零壹贰叁肆伍陆柒捌玖"
  Const strUnit As String = "分角元拾佰仟万拾佰仟亿拾佰仟万拾佰仟亿拾佰仟"
  Dim dblMod As Double  intKey = 1
  strOut = ""
  '设置负数标志，dblMoney最大为17位数，不包括小数位，不大于玖亿亿元。
  If dblMoney < 0 Then
    blnMark = False
  Else
    blnMark = True
  End If
  dblTemp = Abs(Round(dblMoney, 2) * 100)
  
  'lngSpot = dblTemp - Round(dblTemp / 100, 0) * 100
  lngSpot = (dblTemp Mod 100)
  
  Do While dblTemp > 0
    strOut1 = Right(strOut1, 1)
    dblMod = dblTemp Mod 10
    strOut1 = Left(strNumic, dblMod + 1)
    strOut1 = Right(strOut1, 1)
    
    strOut2 = Left(strUnit, intKey)
    strOut2 = Right(strOut2, 1)
    
    strOut = strOut1 & strOut2 + strOut
    
    dblTemp = Int(dblTemp / 10)
    intKey = intKey + 1
  Loop
  strOut = Replace(strOut, "零分", "")
  strOut = Replace(strOut, "零角", "")
  Do While (InStr(strOut, "零元") <> 0) Or (InStr(strOut, "零拾") <> 0) Or _
           (InStr(strOut, "零佰") <> 0) Or (InStr(strOut, "零仟") <> 0) Or _
           (InStr(strOut, "零万") <> 0) Or (InStr(strOut, "零亿") <> 0) Or _
           (InStr(strOut, "零零") <> 0)
    strOut = Replace(strOut, "零亿", "亿零")
    strOut = Replace(strOut, "零万", "万零")
    strOut = Replace(strOut, "零仟", "零")
    strOut = Replace(strOut, "零佰", "零")
    strOut = Replace(strOut, "零拾", "零")
    strOut = Replace(strOut, "零元", "元")
    strOut = Replace(strOut, "零零", "零")
  Loop
  strOut = Replace(strOut, "亿万", "亿")
  If strOut <> "" And lngSpot = 0 Then
    strOut = Trim(strOut) + "整"
  End If
  If blnMark = False Then
    strOut = "负" & strOut
  End If
  MoneyToUper = strOut
End Function不能转换大于9999999.99的数主要是因为我用了取余函数
MOD,这个函数只要数大于999999999就会溢出，谁能解决这个
还可以转换多几位

Answer 5

VB　真是垃圾　吗？
让你写成这样。还有脸拿出来。
去死吧！！！！！！！Public Function rmb(s As Currency) As String 
　　 s1$ = LTrim(Str$(Abs(s))) 
　　 L% = Len(s1) 
　　 Select Case L - InStrRev(s1, ".") 
　　 
　　 Case L 
　　 s2$ = s1 + ".00" 
　　 Case 1 
　　 s2$ = s1 + "0" 
　　 Case 2 
　　 s2$ = s1 
　　 End Select 
　　 L = Len(s2) 
　　 DX$ = "" nh
　　 C1$ = "零壹贰叁肆伍陆柒捌玖" 
　　 C2$ = "分角 元拾佰仟万拾佰仟亿拾佰" 
　　 Do While L >= 1 
　　 x$ = Mid(s2, Len(s2) - L + 1, 1) 
　　 DX = DX + IIf(x < > ".", Mid(C1, 
Val(x) + 1, 1) + Trim(Mid(C2, (L - 1) + 1, 1)), "") 
　　 L = L - 1 
　　 Loop 
　　 rmb = DX + "整" 
　　 End Function 
有空多学点东西　。多看看别的语言中的精华。