| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 5918 人关注过本帖, 2 人收藏
标题:金额大小写转换问题
只看楼主 加入收藏
zyangc
Rank: 1
等 级:新手上路
帖 子:12
专家分:5
注 册:2016-4-30
结帖率:100%
收藏(2)
已结贴  问题点数:10 回复次数:12 
金额大小写转换问题
text2的值为100 这个转换了显示 壹佰零拾零元 零角零分 怎么才能显示为壹佰元
模块代码如下
程序代码:
Function RMBChinese(ByVal Rmb As Double) As String
    On Error Resume Next
    Dim Rmbexp As String, Rmbda As String, Expda As String, Lent As Integer, Ntyp As Integer, Icnt As Integer, i As Integer, Trmb As String

    Rmb = Format(Rmb, "###0.00")
    If Rmb > 999999999999.99 Then
        RMBChinese = "需转换的金额整数长度超过了12位!"
        Exit Function
    End If

    Rmbexp = "分角元拾佰仟万拾佰仟亿拾佰仟"
    Rmbda = "零壹贰叁肆伍陆柒捌玖"
    Ntyp = 0
    Trmb = Replace(CStr(Format(Rmb, "0.00")), ".", "")

    If Left(Trmb, 1) = "-" Then
        Trmb = Mid(Trmb, 2)
        Ntyp = 1
    End If

    Expda = ""
    Icnt = Len(Trmb)

    For i = 1 To Icnt
        Expda = Mid(Rmbda, Val(Mid(Trmb, Icnt - i + 1, 1)) + 1, 1) + IIf(Mid(Rmbexp, i, 1) = "", Mid(Rmbexp, i, 1) + " ", Mid(Rmbexp, i, 1)) + Expda
    Next
    RMBChinese = IIf(Ntyp = 1, "" + Expda, Expda)
End Function
2016-11-06 00:16
chen3523
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:33
帖 子:223
专家分:1165
注 册:2013-2-12
收藏
得分:0 
我的笨方法:
Dim Big$(10)
Big(0) = "零": Big(1) = "壹": Big(2) = "贰": Big(3) = "叁": Big(4) = "肆": Big(5) = "伍": Big(6) = "陆": Big(7) = "柒": Big(8) = "捌": Big(9) = "玖"
Dim Little$(1 To 8), Nil$(1 To 2)     '/小数点左边数,小数点后边数
Dim Myint As Integer, Mystr$
Mystr = Val(Rmb)
Myint = InStr(Mystr, ".")     '到小数点有几位数,包括小数点
Dim ForntDot$           '小数点左边数字
Dim SinceDot$             '小数点后的数字
If Myint = 0 Then    '  只有个位数且无小数点
   ForntDot = Mystr
   
Else        ' 有小数点
   SinceDot = Right$(Mystr, (Len(Mystr) - Myint))            '小数点后的数字
   ForntDot = Left$(Mystr, Myint - 1)       '小数点左边数据
End If

Dim n%      '小数点后边数字有几位数
n = Len(SinceDot)

If n = 0 Then
   Nil(1) = "": Nil(2) = ""
ElseIf n = 1 Then
   Nil(1) = Left$(SinceDot, 1): Nil(2) = ""
ElseIf n > 1 Then
   Nil(1) = Left$(SinceDot, 1): Nil(2) = Right$(Left$(SinceDot, 2), 1)
Else
End If

Dim m%       '小数点左边数字有几位数
m = Len(ForntDot)

If m > 8 Then
 ' MsgBox "抱歉!本系统只能记录到千万位。"
  Exit Sub
End If

For i = m + 1 To 8
      Little(i) = ""    '保证小数点左边数字有8位数
Next i


Dim Dstr$    '过渡用瓶子
For i = m To 1 Step -1          '个位数是1位,十位数是2位,…,第八位数是千万
  Dstr = Left$(ForntDot, m + 1 - i)
  Little(i) = Right$(Dstr, 1)
Next i

Dim Mystr1$, Mystr2$    '转换成大写


Mystr1 = IIf(Little(8) = "", "", Big(Val(Little(8))) & "仟")

If Little(7) = "" Then
   Mystr1 = Mystr1
ElseIf Little(7) = "0" Then
   If Little(8) <> "0" And (Little(6) <> "0" Or Little(5) <> "0") Then
      Mystr1 = Mystr1 & Big(Val(Little(7)))
   ElseIf Little(8) <> "0" And (Little(6) = "0" Or Little(5) = "0") Then
      Mystr1 = Mystr1
   ElseIf Little(8) = "0" And (Little(6) = "0" Or Little(5) = "0") Then
      Mystr1 = Mystr1
   ElseIf Little(8) = "0" And (Little(6) <> "0" Or Little(5) <> "0") Then
      Mystr1 = Mystr1
   Else
   End If
ElseIf Little(7) <> "0" Then
   Mystr1 = Mystr1 & Big(Val(Little(7))) & "佰"
Else
End If

If Little(6) = "" Then
   Mystr1 = Mystr1
ElseIf Little(6) = "0" Then
   If Little(7) <> "0" And (Little(5) <> "0") Then
      Mystr1 = Mystr1 & Big(Val(Little(6)))
   ElseIf Little(7) <> "0" And (Little(5) = "0") Then
      Mystr1 = Mystr1
   ElseIf Little(7) = "0" And (Little(5) = "0") Then
      Mystr1 = Mystr1
   ElseIf Little(7) = "0" And (Little(5) <> "0") Then
      Mystr1 = Mystr1
   Else
   End If
ElseIf Little(6) <> "0" Then
   Mystr1 = Mystr1 & Big(Val(Little(6))) & "拾"
Else
End If

If Little(5) = "" Then
   Mystr1 = Mystr1
ElseIf Little(5) = "0" Then
   If Little(6) <> "0" And (Little(4) <> "0") Then
      Mystr1 = Mystr1 & "万"
   ElseIf Little(6) <> "0" And (Little(4) = "0") Then
      Mystr1 = Mystr1 & "万"
   ElseIf Little(6) = "0" And (Little(4) = "0") Then
      Mystr1 = Mystr1 & "万"
   ElseIf Little(6) = "0" And (Little(4) <> "0") Then
      Mystr1 = Mystr1 & "万"
   Else
   End If
ElseIf Little(5) <> "0" Then
   Mystr1 = Mystr1 & Big(Val(Little(5))) & "万"
Else
End If

If Little(4) = "" Then
   Mystr1 = Mystr1
ElseIf Little(4) = "0" Then
   If Little(5) <> "0" And (Little(3) <> "0" Or Little(2) <> "0" Or Little(1) <> "0") Then
      Mystr1 = Mystr1 & Big(Val(Little(4)))
   ElseIf Little(5) <> "0" And (Little(3) = "0" Or Little(2) = "0" Or Little(1) = "0") Then
      Mystr1 = Mystr1
   ElseIf Little(5) = "0" And (Little(3) = "0" And Little(2) = "0" And Little(1) = "0") Then
      Mystr1 = Mystr1
   ElseIf Little(5) = "0" And (Little(3) = "0" Or Little(2) = "0" Or Little(1) = "0") Then
      Mystr1 = Mystr1 & Big(Val(Little(4)))
   ElseIf Little(5) = "0" And Little(3) = "0" And (Little(2) <> "0" Or Little(1) <> "0") Then
      Mystr1 = Mystr1 & Big(Val(Little(4)))
   ElseIf Little(5) = "0" And (Little(3) <> "0" Or Little(2) <> "0" Or Little(1) <> "0") Then
      Mystr1 = Mystr1 & Big(Val(Little(4)))
   Else
   End If
ElseIf Little(4) <> "0" Then
   Mystr1 = Mystr1 & Big(Val(Little(4))) & "仟"
Else
End If


If Little(3) = "" Then
   Mystr1 = Mystr1
ElseIf Little(3) = "0" Then
   If Little(4) <> "0" And (Little(2) <> "0" Or Little(1) <> "0") Then
      Mystr1 = Mystr1 & Big(Val(Little(3)))
   ElseIf Little(4) <> "0" And (Little(2) = "0" Or Little(1) = "0") Then
      Mystr1 = Mystr1
   ElseIf Little(4) = "0" And (Little(2) = "0" Or Little(1) = "0") Then
      Mystr1 = Mystr1
   ElseIf Little(4) = "0" And (Little(2) <> "0" Or Little(1) <> "0") Then
      Mystr1 = Mystr1
   Else
   End If
ElseIf Little(3) <> "0" Then
   Mystr1 = Mystr1 & Big(Val(Little(3))) & "佰"
Else
End If

If Little(2) = "" Then
   Mystr1 = Mystr1
ElseIf Little(2) = "0" Then
   If Little(3) <> "0" And (Little(1) <> "0") Then
      Mystr1 = Mystr1 & Big(Val(Little(2)))
   ElseIf Little(3) <> "0" And (Little(1) = "0") Then
      Mystr1 = Mystr1
   ElseIf Little(4) = "0" And (Little(1) = "0") Then
      Mystr1 = Mystr1
   ElseIf Little(3) = "0" And (Little(1) <> "0") Then
      Mystr1 = Mystr1
   Else
   End If
ElseIf Little(2) <> "0" Then
   Mystr1 = Mystr1 & Big(Val(Little(2))) & "拾"
Else
End If

If Little(1) = "" Then
   Mystr1 = Mystr1
ElseIf Little(1) = "0" Then
   If Little(2) <> "0" And Little(2) <> "" Then
      Mystr1 = Mystr1 & "圆"
   ElseIf Little(2) = "" Then
      Mystr1 = Mystr1
   ElseIf Little(2) = "0" Then
      Mystr1 = Mystr1 & "圆"
   Else
   End If
ElseIf Little(1) <> "0" Then
   Mystr1 = Mystr1 & Big(Val(Little(1))) & "圆"
Else
End If
 
   
If (Nil(1) = "" And Nil(2) = "") Or (Nil(1) = "0" And Nil(2) = "0") Then
   Mystr2 = "整"
Else
   If Nil(1) <> "" And Nil(2) = "" Then Mystr2 = Big(Val(Nil(1))) & "角整"
   If Nil(1) <> "" And Nil(2) <> "" Then Mystr2 = Big(Val(Nil(1))) & "角" & Big(Val(Nil(2))) & "分"
   If Nil(1) <> "" And Nil(2) = "0" Then Mystr2 = Big(Val(Nil(1))) & "角整"
   If Nil(1) = "0" And Nil(2) = "" Then Mystr2 = "整"
   If Nil(1) = "0" And Nil(2) <> "" Then Mystr2 = Big(Val(Nil(1))) & Big(Val(Nil(2))) & "分"
End If
     T_Big = Mystr1 & Mystr2   '转换完成,显示T_Big就可以了
If m >= 2 And Left$(ForntDot, 1) = "0" Then           '十位数以上左边第一位为0
   MsgBox "老兄:没这样表述的,请重新输入吧!"
End If


     T_Big = Mystr1 & Mystr2
If m >= 2 And Left$(ForntDot, 1) = "0" Then MsgBox "老兄:没这样表述的,请重新输入吧!"          '十位数以上左边第一位为0

调试失败3次后,关机睡觉,当醒来时多有收获。
2016-11-06 10:16
zyangc
Rank: 1
等 级:新手上路
帖 子:12
专家分:5
注 册:2016-4-30
收藏
得分:0 
回复 2楼 chen3523
谢谢,已经解决了
程序代码:
Public Function Converts(NumStr As String) As String

    Select Case Val(NumStr)
      Case 0
        Converts = ""
      Case 1
        Converts = ""
      Case 2
        Converts = ""
      Case 3
        Converts = ""
      Case 4
        Converts = ""
      Case 5
        Converts = ""
      Case 6
         Converts = ""
      Case 7
         Converts = ""
      Case 8
         Converts = ""
      Case 9
         Converts = ""
    End Select
End Function


'转换为金额函数
Public Function Up(Dxs As String) As String
'检测为空时
If Trim(Dxs) = "" Then
   Exit Function
End If
If Left(Dxs, 1) = "-" Then
   Dim Fs As Boolean
   Fs = True
   Dxs = Right(Dxs, Len(Dxs) - 1)
End If
  
  Dim Sw As Integer, SzP As Integer, SzUp As Integer, TempStr As String, DXStr As String
    Sw = Len(Trim(Dxs))
    SzP = InStr(1, Trim(Dxs), ".")
    Dim i As Long
If SzP = 0 Then
     For i = 1 To Sw
         TempStr = Right(Trim(Dxs), i)
         TempStr = Left(TempStr, 1)
         TempStr = Converts(TempStr)
         Select Case i
           Case 1
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
           Case 2
               If TempStr = "" Then
                  TempStr = ""
                Else
                  TempStr = TempStr + ""
               End If
           Case 3
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
            Case 4
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
            Case 5
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
            Case 6
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
            Case 7
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
            Case 8
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
            Case 9
               If TempStr = "" Then
                  TempStr = "亿"
                   Else
                  TempStr = TempStr + "亿"
               End If
         End Select
    Dim TempA As String
        TempA = Left(Trim(DXStr), 1)
    If TempStr = "" Then
      Select Case TempA
       Case ""
            DXStr = DXStr
       Case ""
            DXStr = DXStr
       Case ""
            DXStr = DXStr
       Case "亿"
            DXStr = DXStr
       Case Else
            DXStr = TempStr + DXStr
      End Select
      Else
       DXStr = TempStr + DXStr
    End If
     Next
  Else
    For i = 1 To SzP - 1
         TempStr = Right(Trim(Dxs), i + (Sw - SzP + 1))
         TempStr = Left(TempStr, 1)
         TempStr = Converts(TempStr)
         Select Case i
           Case 1
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
           Case 2
               If TempStr = "" Then
                  TempStr = ""
                Else
                  TempStr = TempStr + ""
               End If
           Case 3
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
            Case 4
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
            Case 5
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
            Case 6
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
            Case 7
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
            Case 8
               If TempStr = "" Then
                  TempStr = ""
                   Else
                  TempStr = TempStr + ""
               End If
            Case 9
               If TempStr = "" Then
                  TempStr = "亿"
                   Else
                  TempStr = TempStr + "亿"
               End If
            Case Else
              '超过999999999时自动删除
              TempStr = ""
         End Select
        TempA = Left(Trim(DXStr), 1)
    If TempStr = "" Then
      Select Case TempA
       Case ""
            DXStr = DXStr
       Case ""
            DXStr = DXStr
       Case ""
            DXStr = DXStr
       Case "亿"
            DXStr = DXStr
       Case Else
            DXStr = TempStr + DXStr
      End Select
      Else
       DXStr = TempStr + DXStr
    End If
     Next
'计算小数
   Dim DxstrX As String, XStr As String
      XStr = Right(Trim(Dxs), Sw - SzP)
        For i = 1 To Sw - SzP
         TempStr = Left(XStr, i)
         TempStr = Right(TempStr, 1)
         TempStr = Converts(TempStr)
         Select Case i
           Case 1
            If TempStr = "" Then
               TempStr = ""
               Else
               TempStr = TempStr + ""
            End If
           Case 2
            If TempStr = "" Then
               TempStr = ""
               Else
               TempStr = TempStr + ""
               End If
            Case Else
              '超过两位小数时,自动删除
              TempStr = ""
         End Select
        DxstrX = DxstrX + TempStr
     Next
     DXStr = DXStr + DxstrX
End If
    Up = DXStr
   Sw = InStr(1, Up, "亿万", vbTextCompare)
If Sw > 1 Then
   TempStr = Left(Up, Sw)
   TempStr = TempStr + Right(Up, Len(Up) - Sw - 1)
   Up = TempStr
End If
   Sw = InStr(1, Up, "壹拾", vbTextCompare)
If Sw = 1 Then
   TempStr = Left(Up, Sw - 1)
   TempStr = TempStr + Right(Up, Len(Up) - Sw)
   Up = TempStr
End If
If Up = "" Then
   Up = "零元"
End If
If Fs Then
   Up = "" + Up
End If
End Function

2016-11-06 13:15
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:2 
我写的代码:

程序代码:

Public Function RmbDX(Cs As Double) As String

Const DxTxt = "壹贰叁肆伍陆柒捌玖"

Const JW = 10000
Const JY = 100000000

Dim s As String
Dim R As Double, i As Long
Dim s1 As String
Dim j As Long

'-----------传入0时直接处理掉---------
If Cs = 0 Then
    RmbDX = "零元整"
    Exit Function
End If

R = Cs
'------------亿以上数据--------------
If Cs >= JY Then                '有亿
    s = RmbDX(Int(R / JY))      '递归调用
    s = Left(s, Len(s) - 2)     '去掉多余的 元整
    s = s & "亿"
    R = R - Int(R / JY) * JY    '去掉亿以上数字
End If

'-----------万以上数据----------
If R >= JW Then                 '有万
    s = s & RmbDX(Int(R / JW))  '递归调用
    s = Left(s, Len(s) - 2)     '去掉多余的 元整
    s = s & ""
    R = R - Int(R / JW) * JW    '去掉万以上数字
End If

j = Int(R * 100 + 0.1)          '扩大100倍,不需要处理小数,同时 +0.1 防止浮点数舍入误差
'-----------千以上数据------------
If j >= 100000 Then            '有千位
    i = Int(j / 100000)
    j = j - i * 100000
    s1 = s1 & Mid(DxTxt, i, 1) & ""
Else
    If Len(s) > 0 Then          '如果有递归数据,那么就仟位写零
        s1 = ""
    End If
End If
'-----------百以上数据------------
If j >= 10000 Then            '有百位
    i = Int(j / 10000)
    j = j - i * 10000
    s1 = s1 & Mid(DxTxt, i, 1) & ""
Else
    If Len(s1) > 0 Then         '如果千位有数据
        If s1 <> "" Then s1 = s1 & ""           '并且千位不是零,那么写零去
    End If
End If
'-----------十以上数据------------
If j >= 1000 Then            '有十位
    i = Int(j / 1000)
    j = j - i * 1000
    s1 = s1 & Mid(DxTxt, i, 1) & ""
Else
    If Len(s1) > 0 Then                 '如果前面有数据
        If Right(s1, 1) <> "" Then    '最后一个不是零
            s1 = s1 & ""              '写一个零
        End If
    End If
End If
'-----------一以上数据------------
If j >= 100 Then            '有个位
    i = Int(j / 100)
    j = j - i * 100
    s1 = s1 & Mid(DxTxt, i, 1) & ""
Else
    If Len(s1) > 0 Then
        If Right(s1, 1) <> "" Then        '前面数据最后一位不是零,直接加上元
            s1 = s1 & ""
        Else
            s1 = Left(s1, Len(s1) - 1) & ""       '否则去掉这个零,确保元前面不出现零
        End If
    End If
End If

'-----------小数点后第一位数据------------
If j >= 10 Then           '有小数位
    i = Int(j / 10)
    j = j - i * 10
    If i > 0 Then
        s1 = s1 & Mid(DxTxt, i, 1) & ""           '小数数后面直接带单位
    End If
Else
    s1 = s1 & "零角"                            '零角要求显示
End If

'-----------小数点后第二位数据------------
If j > 0 Then
    i = Int(j)
    If i > 0 Then
        s1 = s1 & Mid(DxTxt, i, 1) & ""           '分也直接带单位
    End If
Else
    s1 = s1 & "零分"                            '零分要求显示
End If

If Right(s1, 4) = "零角零分" Then               '如果是零角零分,则不显示
    s1 = Left(s1, Len(s1) - 4)
End If

'------------总装及返回----------------
s1 = s & s1 & ""
RmbDX = s1

End Function

授人于鱼,不如授人于渔
早已停用QQ了
2016-11-06 13:50
ZHRXJR
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:125
帖 子:1034
专家分:5519
注 册:2016-5-10
收藏
得分:3 
我感到没有这样复杂吧,看看下面的代码:
程序代码:
Public XSSC As String, X As Integer    '定义程序级变量,在通用部分定义即可

Private Sub Command1_Click()
Dim JE As Single, A As Long, B As Long, C As Long, D As Long, E As Long, F As Long, G As Long   '如果你需要转换到亿、十亿乃至百亿、千亿,无非就是多定义几个变量而已
Dim A1 As String, B1 As String, C1 As String, D1 As String, E1 As String, F1 As String, G1 As String    '同上
Label1.Caption = ""
JE = Val(Text1.Text)
If JE <= 99999.99 Then
A = JE \ 10000   '万元
B = (JE - 10000 * A) \ 1000   '千元
C = (JE - 10000 * A - 1000 * B) \ 100    '百元
D = (JE - 10000 * A - 1000 * B - 100 * C) \ 10    '十元
E = Int(JE - 10000 * A - 1000 * B - 100 * C - 10 * D)    '
F = Int((JE - 10000 * A - 1000 * B - 100 * C - 10 * D - E) * 10)    '
G = Int((JE - 10000 * A - 1000 * B - 100 * C - 10 * D - E) * 100 - 10 * F)    '
'以上是取出各位数的值
Call DXHS(A, XSSC): A1 = XSSC
Call DXHS(B, XSSC): B1 = XSSC
Call DXHS(C, XSSC): C1 = XSSC
Call DXHS(D, XSSC): D1 = XSSC
Call DXHS(E, XSSC): E1 = XSSC
Call DXHS(F, XSSC): F1 = XSSC
Call DXHS(G, XSSC): G1 = XSSC
'以上是将各位的数字转换成大写
Label1.Caption = A1 + "" + B1 + "" + C1 + "" + D1 + "" + E1 + "" + F1 + "" + G1 + ""      '显示出来转换的大写金额
Else
MsgBox "对不起,你的金额大于了99999.99!"
Text1.Text = ""
Text1.SetFocus
End If
End Sub

Private Sub Form_Load()
Text1.Text = ""
Label1.Caption = ""
End Sub

Public Sub DXHS(X, XSSC)   '大小写转换过程
Select Case X
    Case 1: XSSC = ""
    Case 2: XSSC = ""
    Case 3: XSSC = ""
    Case 4: XSSC = ""
    Case 5: XSSC = ""
    Case 6: XSSC = ""
    Case 7: XSSC = ""
    Case 8: XSSC = ""
    Case 9: XSSC = ""
    Case 0: XSSC = ""
End Select
End Sub

图片附件: 游客没有浏览图片的权限,请 登录注册

请不要选我!!!
2016-11-06 14:56
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
回复 5楼 ZHRXJR
不能出现多余的零。
如,300,转换成 叁佰元整,不能为 叁佰零拾零元整。
301000,要转换成 叁拾万壹仟元整,不能叁拾零万壹仟零佰零拾零元整。

授人于鱼,不如授人于渔
早已停用QQ了
2016-11-06 16:56
ZHRXJR
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:125
帖 子:1034
专家分:5519
注 册:2016-5-10
收藏
得分:0 
回复 6楼 风吹过b
你的这个要求可以实现,但是必须有相应的判断,估计判断语句不会少。
将你需要的情况列出,帮你实现。
其实使用数组比刚刚给你的程序还要简单,加QQ我帮你实现。

[此贴子已经被作者于2016-11-6 18:35编辑过]


请不要选我!!!
2016-11-06 18:22
xzlxzlxzl
Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15
来 自:湖北
等 级:贵宾
威 望:125
帖 子:1091
专家分:5825
注 册:2014-5-3
收藏
得分:5 
回复 7楼 ZHRXJR
要给VB常驻版主解决问题,热心可嘉!不过是不是有点太自信了。别多心:我是说你自信风版主非常需要你的帮助

这个金额大小写转换看起来简单,真要符合人的读写习惯还是要费些脑子的,无非是消零或加零。动了下脑子,好像真不需要前面几位那么复杂的逻辑的,我的代码如下(有注释),敬请大神们测试!
程序代码:
Function RMBChinese(ByVal Rmb As Double) As String
    Const dx = "零壹贰叁肆伍陆柒捌玖"
    Const dw = "分角元拾佰仟万拾佰仟亿拾佰仟万兆拾佰仟万亿京"
    Dim a As String, b As String, c As String, i As Integer, j As Integer, l As Integer
    Rmb = Format(Rmb, "###0.00")
    a = Trim(Str(Abs(Rmb)))                                       '由于普通long、integer类型不能表达足够位数,double数据有取整误差,转成字符串更好做
    b = ""
    For i = 1 To Len(a)
      If Mid(a, i, 1) <> "." Then b = Mid(a, i, 1) & b            '去掉小数点,倒序便于后面处理
    Next
    If Len(b) > 14 Then Exit Function                             '14位是一个double能有效表达的数据最多有效位了
    l = 3                                                         'l作为单位读取点,默认从单位元开始
    If InStr(a, ".") > 0 Then l = 3 + InStr(a, ".") - Len(a)      '如果有小数点则从分或角开始读取
    a = ""
    For i = 1 To Len(b)
      j = Val(Mid(b, i, 1))
      a = Mid(dx, j + 1, 1) & Mid(dw, l, 1) & a
      l = l + 1
    Next
    b = ""
    For i = 1 To Len(a)
      If Mid(a, i, 1) <> "" Then b = b & Mid(a, i, 1)           '消零
    Next
    a = ""
    j = 0
    l = 0
    For i = 1 To Len(b)
      c = Mid(b, i, 1)
      If InStr(dx, c) > 0 Then
        If j > 0 Then a = a & ""                                '合并连续渐小的单位为零
        a = a & c
        j = 0
        l = 0
      Else
        If InStr(dw, c) > l Or c = "" Then
          a = a & c
          l = InStr(dw, c)
        Else
          j = j + 1
        End If
      End If
    Next
    If Rmb < 0 Then a = "" & a
    If Right(a, 1) = "" Then a = a & ""
    RMBChinese = a
End Function


我的测试样例如下:
1001010.67     壹佰万零壹仟零壹拾元陆角柒分
1              壹元整
100            壹佰元整
10000          壹万元整
1000000        壹佰万元整
100000000001   壹仟亿零壹元整
123456789      壹亿贰仟叁佰肆拾伍万陆仟柒佰捌拾玖元整
123456789.98   壹亿贰仟叁佰肆拾伍万陆仟柒佰捌拾玖元玖角捌分
100023001      壹亿零贰万叁仟零壹元整
2016-11-06 22:27
新手VB
Rank: 2
等 级:论坛游民
帖 子:72
专家分:11
注 册:2016-1-24
收藏
得分:0 
回复 8楼 xzlxzlxzl
非常好用
2016-11-07 12:22
林天呢
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2017-6-10
收藏
得分:0 
可以问下8楼vb界面么……😭
2017-06-10 17:16
快速回复:金额大小写转换问题
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.042860 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved