金额大小写转换问题 - VB6论坛

楼主

已结贴√ 问题点数：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

第 2 楼

得分: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次后，关机睡觉，当醒来时多有收获。

第 3 楼

得分: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

第 4 楼

得分: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了

第 5 楼

得分: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

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

请不要选我！！！

第 6 楼

得分:0

回复 5楼 ZHRXJR

不能出现多余的零。
如，300，转换成叁佰元整，不能为叁佰零拾零元整。
301000，要转换成叁拾万壹仟元整，不能叁拾零万壹仟零佰零拾零元整。

授人于鱼，不如授人于渔
早已停用QQ了

第 7 楼

得分:0

回复 6楼风吹过b

你的这个要求可以实现，但是必须有相应的判断，估计判断语句不会少。
将你需要的情况列出，帮你实现。
其实使用数组比刚刚给你的程序还要简单，加QQ我帮你实现。

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

请不要选我！！！

第 8 楼

得分: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      壹亿零贰万叁仟零壹元整

第 9 楼

得分:0

回复 8楼 xzlxzlxzl

非常好用

第 10 楼

得分:0

可以问下8楼vb界面么……😭