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

叶小血

留着慢慢学习

YZC51

Public Function yjgs(m, Optional n = 3500)  '个税计算'
    Q = m - n
    Select Case Q
        Case Is > 80000: x = Q * 0.45 - 13505
        Case Is > 55000: x = Q * 0.35 - 5505
        Case Is > 35000: x = Q * 0.3 - 2755
        Case Is > 9000: x = Q * 0.25 - 1005
        Case Is > 4500: x = Q * 0.2 - 555
        Case Is > 1500: x = Q * 0.1 - 105
        Case Is > 0: x = Q * 0.03
        Case Else: x = 0
    End Select
    yjgs = Round(x, 2)
End Function

YZC51

Public Function yjgs(m, Optional n = 5000)  '个税计算2019按月换算
    Q = m - n
    Select Case Q
        Case Is > 80000: x = Q * 0.45 - 15160
        Case Is > 55000: x = Q * 0.35 - 7160
        Case Is > 35000: x = Q * 0.3 - 4410
        Case Is > 25000: x = Q * 0.25 - 2660
        Case Is > 12000: x = Q * 0.2 - 1410
        Case Is > 3000: x = Q * 0.1 - 210
        Case Is > 0: x = Q * 0.03
        Case Else: x = 0
    End Select
    yjgs = Round(x, 2)
End Function

Public Function aygs(m, Optional n = 5000)  '个税计算2019按年换算
    Q = m - n
    Select Case Q
        Case Is > 960000: x = Q * 0.45 - 18190
        Case Is > 660000: x = Q * 0.35 - 85920
        Case Is > 420000: x = Q * 0.3 - 52920
        Case Is > 300000: x = Q * 0.25 - 31920
        Case Is > 144000: x = Q * 0.2 - 16250
        Case Is > 36000: x = Q * 0.1 - 2520
        Case Is > 0: x = Q * 0.03
        Case Else: x = 0
    End Select
    aygs = Round(x, 2)
End Function

YZC51

上传附件
个税计算公式.rar (423.64 KB, 下载次数: 55)

2019-10-13 08:40 上传

点击文件名下载附件

YZC51

Function 统计区域词语数(rng As Range) As Long
For Each rg In rng
    s = Split(rg.Value, Chr(10)): n = n + UBound(s) + 1
Next
统计区域词语数 = n
End Function

YZC51

上传附件
自定义函数-统计区域词语数-.zip (18.88 KB, 下载次数: 37)

2019-10-17 09:32 上传

点击文件名下载附件

YZC51

Function ss(txt) '单元格内排序
    Dim n As Integer
    Dim arr()
    n = Len(txt)
    ReDim arr(1 To n)
    For i = 1 To n
        arr(i) = Mid(txt, i, 1)
    Next
    For i = 1 To n - 1
        For j = i + 1 To n
        If arr(i) > arr(j) Then
            temp = arr(i)
            arr(i) = arr(j)
            arr(j) = temp
        End If
        Next
    Next
    ss = Join(arr, "")
End Function

Function saas(txt) '单元格内去重后计数
    Dim n As Integer
    Dim arr()
    n = Len(txt)
    m = n
    ReDim arr(1 To n)
    For i = 1 To n
        arr(i) = Mid(txt, i, 1)
    Next
    For i = 1 To n - 1
        For j = i + 1 To n
        If arr(i) > arr(j) Then
            temp = arr(i)
            arr(i) = arr(j)
            arr(j) = temp
        End If
        Next
    Next
    For i = 1 To n - 1
    If arr(i) = arr(i + 1) Then m = m - 1
    Next
    saas = m ' Join(arr, "")
End Function

Function sas(txt) '单元格内去重后计数
    Dim n As Integer
    Dim arr()
    n = Len(Replace(txt, Space(1), vbNullString))
    m = n
    ReDim arr(1 To n)
    For i = 1 To n
        arr(i) = Mid(txt, i, 1)
    Next
    For i = 1 To n - 1
        For j = i + 1 To n
        If arr(i) = arr(j) Then m = m - 1: i = i + 1
        Next
    Next
    sas = m
End Function

YZC51

Function strSort(str1 As String, Optional x = 0)  '单元格内排序去重&计数
'x=1 单元格内去重排序、x=0 单元格内去重计数
'除汉字、全角字符、特殊字符以外的所有字符串
    Dim arr(255) As String
    For i = 1 To Len(str1)
        arr(Asc(Mid(str1, i, 1))) = Mid(str1, i, 1)
    Next
    strSort = Len(Join(arr, ""))
    If x Then strSort = Join(arr, "")
End Function

YZC51

http://club.excelhome.net/thread-1259476-1-1.html
Function qc(Rng As Range, Optional x = 0) '单元格内或者区域去重
    Dim rg As Range, i As Long, dic
    Set dic = CreateObject("scripting.dictionary")
    For Each rg In Rng
        For i = 1 To Len(rg)
            If Not dic.Exists(Mid(rg, i, 1)) Then
                dic(Mid(rg, i, 1)) = ""
            End If
        Next
    Next
    qc = Join(dic.keys, "")
    If x = 0 Then qc = Len(qc)
End Function

YZC51

Function tqc(txt, Optional x = 0) '字符串去重
    Dim i As Long, dic
    Set dic = CreateObject("scripting.dictionary")
    txt = Replace(txt, Space(1), "")
    m = Len(txt)
    If m > 0 Then
        For i = 1 To m
            If Not dic.Exists(Mid(txt, i, 1)) Then
                dic(Mid(txt, i, 1)) = ""
            End If
        Next
    End If
    tqc = Join(dic.keys, "")
    If x = 0 Then tqc = Len(tqc)
End Function