【12-24 Eve版大更新】大一统！空前强大的中文大小写-财务金额-阿拉伯数字互转函数

microyip

高大上啊，过来咬一口，增加点牙齿印，说明还是有齿的

wxhnr

开始以为是标题党，没想到真的强大。

YZC51

老师的优秀作品，真的很强大！！！

月关

这本来只是一个闲着无聊打发时间的作品，感谢蓝桥玄霜老师的肯定，感谢上面所有老师不吝赞美的鼓励。
这其实都是偷师你们的，我只是给攒巴起来而已。

另外，刚刚发现，因为后期更改了参数，所以原来的示例转化有点小问题，参数往后移一位即可，如下：
拾万零两佰3拾圆五角4分 →  =NumSwitch(NumSwitch(NumSwitch(F11,5)),2)  结果为：壹拾万零贰佰叁拾元伍角肆分

zopey

1. Sub pey_testb()
   
2. Dim arr, k0
   
3. k0 = [a1].End(4).Row - 1
   
4. arr = [a2].Resize(k0, 2)
   
5. 
   
6. For i = 1 To k0
   
7.    arr(i, 2) = getz(CStr(arr(i, 1)))
   
8. Next
   
9. 
   
10. [a2].Resize(k0, 2) = arr
    
11. End Sub
    
12. 
    
13. Function getz(q As String)
    
14. Dim s1, temp1
    
15. s1 = Replace(Replace(q, "整", ""), "正", "")
    
16. 
    
17. With CreateObject("VBScript.RegExp")
    
18.   .Global = True
    
19.   .IgnoreCase = False
    
20.   .Pattern = "([零壹贰叁肆伍陆柒捌玖○仟佰拾]*?)([兆亿万元角分])"
    
21.    
    
22.    temp1 = "=""" & .Replace(s1, """ & qukh(" & """$1""" & "," & """$2""" & ") & """) & """"
    
23. End With
    
24. 
    
25. getz = Evaluate(temp1)
    
26. Mid(getz, 1, 1) = "="
    
27. End Function
    
28. 
    
29. Function qukh(a, b)
    
30.     qukh = "+gety(""" & a & """)*" & 10 ^ (InStr("分角元000万000亿000兆", b) - 3)
    
31. End Function
    
32. 
    
33. Function gety(r As String) As Long
    
34. Dim s2, temp2
    
35. s2 = Replace(Replace(r & "个", "零", ""), "○", "")
    
36. 
    
37. With CreateObject("VBScript.RegExp")
    
38.   .Global = True
    
39.   .IgnoreCase = False
    
40.   .Pattern = "([壹贰叁肆伍陆柒捌玖]*?)([仟佰拾个])"
    
41.    
    
42.    temp2 = "=""" & .Replace(s2, """ & getx(" & """$1""" & "," & """$2""" & ") & """) & """"
    
43. End With
    
44. 
    
45. gety = Evaluate(Evaluate(temp2))
    
46. End Function
    
47. 
    
48. Function getx(c, d)
    
49.     getx = "+" & InStr("零壹贰叁肆伍陆柒捌玖", c) - 1 & "*" & 10 ^ (InStr("个拾佰仟", d) - 1)
    
50. End Function

复制代码

zopey

自定义函数  getz =  Evaluate(Evaluate(temp1)）不能自动计算，

故变通下 ：
getz = Evaluate(temp1)
Mid(getz, 1, 1) = "="


用sub 往单元格写入中间公式。

财务金额转数字 .rar (18.89 KB, 下载次数: 11)

2019-12-18 23:47 上传

点击文件名下载附件

YZC51

请参考
http://club.excelhome.net/thread-66279-1-1.html

Function ZW2ALB(A As String, Optional z = 1)  ' 中文大小写转数字函数
    Application.Volatile True
    A = A & "."
    If z Then
        Hsf = "   十百千万   亿"
        Hs = "○一二三四五六七八九 "
    Else
        Hsf = "分角元拾佰仟万   亿"
        Hs = "零壹贰叁肆伍陆柒捌玖 "
    End If
    JH = 1
    A = Replace(A, "整", "")
    A = Replace(A, "亿", ")亿")
    A = Replace(A, "万", ")万")
    If A <> "" Then
        Mylen = Len(A$)
        For m = 1 To Mylen
            If Mid(A, m, 1) = "万" And JH = 1 Then A = "(" & A: JH = 0
            If Mid(A, m, 1) = "亿" Then
                A = "(" & A
                JH = 0
                For K = m + 3 To Mylen + 2
                    If Mid(A$, K, 1) = "万" Then
                        A = Replace(A, "亿", "亿(")
                        Exit For
                    End If
                Next
                Exit For
            End If
        Next
        For i = 0 To 10
            A = Replace(A, Mid(Hs, i + 1, 1), i)
            A = Replace(A, Mid(Hsf, i + 1, 1), "*" & (10 ^ (i - 2)) & "+")
        Next
        A = Replace(A, "+)", ")")
        A = Replace(A, "+*", "*")
        Mylen = Len(A)
        A = Left(A, Mylen - 1)
        ZW2ALB = Evaluate(A)
    End If
End Function

YZC51

’学习LDY 和 大理 两位版主的代码。谢谢老师们！

Function ToN(ss)
    If Len(ss) = 0 Then ToN = "": Exit Function
    xsd = InStr(ss & ".", "."): xs = Mid(ss, xsd + 1)       '中文财务及大小写数字转阿拉伯数字
    ss = Mid(ss, 1, xsd - 1) & "圆"
    For i% = 1 To 9
        ss = Replace(ss, Mid("壹贰叁肆伍陆柒捌玖", i, 1), i)            '取中文大写整数
        ss = Replace(ss, Mid("一二三四五六七八九", i, 1), i)            '取中文小写整数
        If Len(xs) = 0 Then GoTo xx
        xs = Replace(xs, Mid("壹贰叁肆伍陆柒捌玖", i, 1), i)            '取中文大写小数
        xs = Replace(xs, Mid("一二三四五六七八九", i, 1), i)            '取中文小写小数
xx:
    Next
    xs = "0." & xs                                                      '合成小数
    For i% = Len(ss) To 1 Step -1                                       '生成占位 0
        s$ = Mid$(ss, i, 1)
        x% = InStr("分角圆拾佰仟万000亿000兆", s)
        If x = 0 Then x% = InStr("0毛元十百千萬000億", s)
        If x Then j% = IIf(j% < x, x, ((j - 3) \ 4) * 4 + x)
        If Val(s) Then m# = m# + (s & String(j - 1, "0")) / 100
    Next
    ToN = m + xs: If InStr(ss, "-") Or InStr(ss, "负") Then ToN = -ToN
End Function

YZC51

附件来啦
中文财务及大小写数字与阿拉伯数字互转-V1.2.rar (65.78 KB, 下载次数: 6)

2019-12-20 19:05 上传

点击文件名下载附件

YZC51

好像是最简函数。请老师们斧正！谢谢！

Public Function YZC(s, Optional Z = 0) '中文数字与阿拉伯数字互转 原创 2019-12-20
    If Len(s) = 0 Then YZC = "": Exit Function
    If Z = 1 Then YZC = ToN(s): Exit Function
    If Z = 2 Then YZC = Application.Text(s, "[<20][dbnum1]d;[dbnum1]"): Exit Function
    If Z = 3 Then YZC = Replace(Application.Text(s, "[dbnum1]"), "-", "负"): Exit Function
    If Z = 4 Then YZC = Replace(Application.Text(s, "[dbnum2]"), "-", "负"): Exit Function
    M = Abs(s): If M < 0.005 Then YZC = "": Exit Function
    gs = "[dbnum2]"
    If M >= 0.995 And M < 1 Then M = 1
    g$ = IIf(M < 0.095, "", "0角")
    a = IIf(M < 1, "", Application.Text(Int(Abs(M)), gs) & "元")
    b = Application.Text((Abs(M) - Int(Abs(M))) * 100 + 0.01, gs & g & "0分")
    c = Replace(Replace(Replace(a & b, "零分", "整"), "零角整", "整"), "零角", "零")
    YZC = IIf(s < 0, "负", "") & c
End Function