请教：人民币金额小写转换为大写函数算法

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 IfChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元" & s1)End Function

解决方案 »

  1.   

    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 IfChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元" & s1)End Function
      

  2.   

    不记得从哪里抄来的:)
    '参数一为数字
    '参数二为是不是反回人民币大写
    '参数三为是不是直接读数字，否则带有十百等单位
    '参数四为设置小数点后面的位数，默认为4
    Function GetChinaNum(otherNum As Double, Optional isRMB As Boolean, Optional numOption As Boolean, Optional dotNum As Integer) As String
        On Error Resume Next
        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 Not 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 = True 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
      

  3.   

    注意：参数要求小于1亿！！！！！！！！！！！！！
    Public Function ConvToMoney(ByVal strDigital As String) As String
        Dim strChi(11), strDig(10)  As String
        Dim StrTmp, strRs As String
        Dim lenStr As Byte
        Dim strLast As String
        Dim i, d As Byte
        Dim blnZero As Boolean
        Dim strTmprv, dstr As String
        
        '-------------------------
        '--判断是否为数值型...
        '-------------------------
        If Not IsNumeric(strDigital) Then
            ConvToMoney = ""
            Exit Function
        End If
        
        If Val(Format(strDigital)) < 0 Then
            strDigital = Trim(str(Abs(Val(Format(strDigital)))))
            strLast = "整(负)"
        Else
            strLast = "整"
        End If
        '初始化数组
        strChi(0) = "分"
        strChi(1) = "角"
        strChi(2) = "元"
        strChi(3) = "拾"
        strChi(4) = "佰"
        strChi(5) = "仟"
        strChi(6) = "万"
        strChi(7) = "拾"
        strChi(8) = "佰"
        strChi(9) = "仟"
        strChi(10) = "亿"
        
        strDig(0) = "零"
        strDig(1) = "壹"
        strDig(2) = "贰"
        strDig(3) = "叁"
        strDig(4) = "肆"
        strDig(5) = "伍"
        strDig(6) = "陆"
        strDig(7) = "柒"
        strDig(8) = "捌"
        strDig(9) = "玖"
        StrTmp = strDigital
        '------------------------------------------
        '--当字符串长度为0或长度超过11个字符返回空...
        '------------------------------------------
        If (Len(StrTmp) = 0) Or (Len(StrTmp) > 11) Then
         ConvToMoney = ""
         Exit Function
        End If
        StrTmp = Format(StrTmp, "########.00")
        
        lenStr = Len(StrTmp)
        
        '-------------------
        '--转换角和分...
        '-------------------
        strRs = strDig(Val(Mid(StrTmp, lenStr - 1, 1))) & _
                strChi(1) & strDig(Val(Right(StrTmp, 1))) & strChi(0)
        '-------------------
        '--取出整数部分...
        '-------------------
        StrTmp = Left(StrTmp, Len(StrTmp) - 3)
        
        '-------------------
        '--反转整型部分...
        '-------------------
        For i = 1 To Len(StrTmp)
          strTmprv = Mid(StrTmp, i, 1) & strTmprv
        Next
        
        For i = 1 To Len(strTmprv)
         d = Val(Mid(strTmprv, i, 1))
         If d = 0 Then
           If i = 1 Or i = 5 Then
              dstr = strChi(i + 1)
           Else
             If Not blnZero Then
              dstr = strDig(0)
             Else
              dstr = ""
             End If
           End If
           blnZero = True
         Else
           dstr = strDig(d) & strChi(i + 1)
           blnZero = False
         End If
         strRs = dstr + strRs
        Next
        ConvToMoney = strRs & strLast
    End Function
      

  4.   

    初学VB，大致地写了一个算法，在VB6.0下调试通过。有什么更好的办法，大家共同切磋。
    Option Explicit
    Dim temp As Variant
    Dim dot As Integer
    Dim m As Integer
    Dim tempstr As String
    Dim outputstr As String
    Dim fixnum As Integer
    '本函数主要用来实现对应的大小写称呼的转换
    Function smalltobig(a As Integer, b As Integer)
       'b:0代表数字的大小写转换
       'b:1代表单位的大小写转换
       Dim value0, value1 As Variant
       value0 = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "镹")
       value1 = Array("拾", "佰", "仟", "萬", "億")
       If b = 0 Then
          smalltobig = value0(a)
       ElseIf b = 1 Then
          smalltobig = value1(a)
       End If
    End Function
    '本函数主要用来实现每四位的相应转换
    Function change(i As Integer)
       Dim funstr As String
       funstr = ""
       tempstr = Format(Right(temp, 4), "0000")
       funstr = smalltobig(Right(tempstr, 1), 0) + funstr
       funstr = smalltobig(Fix(Right(tempstr, 2) / 10), 0) + smalltobig(0, 1) + funstr
       funstr = smalltobig(Fix(Right(tempstr, 3) / 100), 0) + smalltobig(1, 1) + funstr
       funstr = smalltobig(Fix(tempstr / 1000), 0) + smalltobig(2, 1) + funstr
       If i = 2 Then
          funstr = funstr + smalltobig(3, 1)
       End If
       If i = 3 Then
          funstr = funstr + smalltobig(4, 1)
       End If
       change = funstr
    End Function
    Private Sub Command1_Click()
       temp = Trim(Text1.Text)
       dot = InStr(temp, ".")
       temp = Val(Trim(Text1.Text))
       If dot <> 0 Then
          temp = Left(temp, dot - 1)
       End If
       outputstr = ""
       fixnum = Fix(Len(temp) / 4)
       For m = 1 To fixnum
           outputstr = change(m) + outputstr
           temp = Left(temp, Len(temp) - 4)
       Next m
       outputstr = outputstr + "元"
       temp = Val(Trim(Text1.Text))
        '角和分的转换
       If dot <> 0 Then
          temp = Right(temp, Len(temp) - dot)
          outputstr = outputstr + smalltobig(Left(temp, 1), 0) + "角"
          outputstr = outputstr + smalltobig(Right(Left(temp, 2), 1), 0) + "分"
       End If
       Text2.Text = outputstr
    End Sub
      

  5.   

    去看我的文档
    http://www.csdn.net/develop/read_article.asp?id=14036
      

  6.   

    这位前辈晚生有礼了,
    先驱们的探索值得钦佩,
    不要动怒.我觉得只要是能够使用的代码,就是好代码.
    不看长短,功能简单的话还可以不管效率FORMAT的确可以使用,
    但是没有FORMAT的年代,
    就只有用他们的脑子了.而且这种讨论很有益身心健康,
    交流的乐趣尽在其中.
      

  7.   

    这种程序有这么无聊吗？
    Bardo程序确实好，但兼容性如何？支持VB5吗？你知道VB5的好处吗？
    Function N2S(ByVal n As String) As String
        N2S = Mid("零壹贰叁肆伍陆柒捌玖", Val(n) + 1, 1)
    End Function
    Function Money2RMB_1(ByVal mn As String, ByVal dep As Long) As String
        Dim nn, s As String, r As String, i As Integer
        nn = Array("", "十", "百", "千")
        nn(0) = Mid("元万亿", dep, 1)
        If Len(mn) > 4 Then s = Right(mn, 4) Else s = String(4 - Len(mn), "0") + mn
        For i = 1 To Len(s)
            If i > 1 Then If Mid(s, i - 1, 1) = "0" And Right(r, 1) <> "零" And r <> "" Then r = r + "零"
            If Mid(s, i, 1) <> "0" Then r = r + IIf(Mid(s, i, 1) = "1" And nn(4 - i) = "十", "", N2S(Mid(s, i, 1))) + nn(4 - i)
        Next
        If Len(mn) > 4 Then r = Money2RMB_1(Left(mn, Len(mn) - 4), dep + 1) + r
        Money2RMB_1 = r + IIf(Right(r, 1) = "元", "", "元")
    End Function
    Function Money2RMB(ByVal mn As String) As String
        Dim dw, s As String, r As String, i As Integer
        dw = Array("角", "分")
        If InStr(mn, ".") = 0 Then mn = mn + "."
        If InStr(mn, ".") <> 0 Then s = Right(mn, Len(mn) - InStr(mn, ".")) Else s = ""
        For i = 1 To Len(s)
            If Mid(s, i, 1) <> "0" Then r = r + N2S(Mid(s, i, 1)) + dw(i - 1)
        Next
        r = Money2RMB_1(Left(mn, InStr(mn, ".") - 1), 1) + r
        Money2RMB = r
    End FunctionPrivate Sub Form_Load()
        Debug.Print Money2RMB("120.1")
    End Sub如果你认为这程序还太长，我仍然可以缩减。但单纯的代码大战确实没有任何意义。
    Bardo确实是高手。我非常佩服他。但有些人总在以维护Bardo名声的名义破坏Bardo的名声。可悲呀！
      

  8.   

    告查贴者:
    数字转人民币大写:
    http://qianfeng.diy.163.com/Num2RMB.zip
    有个dll和使用说明,直接使用,无需重复劳动.