自定义函数--提取单元格内多个被分开的数字

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

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("分角圆拾佰仟万   亿   兆", s)
        If x = 0 Then x% = InStr(" 毛元十百千萬   億", 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 发表于 2019-2-12 08:32
通用的双条件查询函数说明：
1、X1 设定X 位于第几列；
2、Y1 设定Y 位于第几列，Y1 等于0时，为单条件查 ...

楼主辛苦了

YZC51

浮生若梦~~~ 发表于 2019-12-16 15:19
楼主辛苦了

谢谢老师花花鼓励！

YZC51

N级联动菜单

N级联动菜单.rar (160.74 KB, 下载次数: 34)

2019-12-17 18:37 上传

点击文件名下载附件

YZC51

中文数字转阿拉伯数字-V1.0

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

2019-12-20 19:08 上传

点击文件名下载附件

YZC51

Public Sub 打开设计模式()
Application.CommandBars("Control Toolbox").Controls(1).Execute
End Sub

Public Sub 关闭设计模式()
Set a = Application.CommandBars("Control Toolbox").Controls(1)
End Sub

YZC51

Public Function YZC(s) '阿拉伯数字转中文大写数字
    M = Abs(s): If Len(s) = 0 Or M < 0.005 Then YZC = "": Exit Function
    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)), "[dbnum2]") & "元")
    b = Application.Text((Abs(M) - Int(Abs(M))) * 100 + 0.01, "[dbnum2]" & g & "0分")
    c = Replace(Replace(Replace(a & b, "零分", "整"), "零角整", "整"), "零角", "零")
    YZC = IIf(s < 0, "负", "") & c
End Function

YZC51

‘大写金额转阿拉伯数字及中文大、小写转阿拉伯数字

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

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

'Private
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("分角圆拾佰仟万   亿   兆", s)
        If x = 0 Then x% = InStr(" 毛元十百千萬   億", 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

maozhe

YZC51 发表于 2019-12-8 10:07
Public Function MINIF(nub, Optional Z = 0)  '原创
    Dim temp    '自定义MINIF函数-提取区域内大于 Z ...

以下代码是不是更适合！

1. Function Minif(RNG As Range, Optional Z = 0)   '原创
   
2.     Dim Temp    '自定义MINIF函数-提取区域内大于 Z 最小值
   
3.     ar = RNG.Value
   
4.     Temp = Max(ar)
   
5.     For Each c In ar
   
6.         If Val(c) > Z Then
   
7.             If c < Temp Then Temp = c
   
8.         End If
   
9.     Next
   
10.     Minif = Temp
    
11. End Function

复制代码

YZC51

maozhe 发表于 2019-12-19 23:04
以下代码是不是更适合！

谢谢老师指教！
Function Minif(RNG As Range, Optional Z = 0)   '原创
    Dim Temp    '自定义MINIF函数-提取区域内大于 Z 最小值
    ar = RNG.Value
    Temp = Application.Max(ar)
    For Each c In ar
        If Val(c) > Z Then
            If c < Temp Then Temp = c
        End If
    Next
    Minif = Temp
End Function