个税计算2.0

Public dic As Object, dic_工资求和 As Object, dic_已交税额 As Object, dic_项目信息 As Object, dic_受雇日期 As Object
Public ar_res, ar_src

Sub main()
    '        Application.ScreenUpdating = False
    清空
    受雇日期装入字典
    获取原始数据_身份证号码和姓名
    受雇日期和人员状态写入字典
    在结果数组填写受雇日期和人员状态
    计算合计已申报金额和合计已交税
    '    结果输出
    计算本月交税合计金额
    项目信息写入字典
    '    结果输出
    输出项目信息
    计算分摊税金
    '******
    结果输出
    销毁
    '        Application.ScreenUpdating = True
    MsgBox "OK"
End Sub

Sub 销毁()
    Set dic = Nothing
    Set dic_工资求和 = Nothing
    Set dic_已交税额 = Nothing
    Set dic_项目信息 = Nothing
    Set dic_受雇日期 = Nothing
End Sub

Sub 受雇日期装入字典()
    Set dic_受雇日期 = CreateObject("scripting.dictionary")
    With Sheet2
        ar = .Range("a1").CurrentRegion
        For x = 2 To UBound(ar)
            dic_受雇日期(ar(x, 4)) = ar(x, 11)
        Next
    End With
End Sub

Sub 计算分摊税金()
    For x = 1 To UBound(ar_res)
        If dic_项目信息.exists(ar_res(x, 1)) Then
            项目个数 = dic_项目信息(ar_res(x, 1))(4)
            If ar_res(x, 8) > 0 Then
                Call 填写分摊个税(项目个数, x)
            End If
        End If
    Next
End Sub

Sub 填写分摊个税(n, row_index)
    For x = 1 To n
        ar_res(row_index, 12 + k) = Round(ar_res(row_index, 8) / ar_res(row_index, 5) * ar_res(row_index, 11 + k), 2)
        k = k + 5
    Next
End Sub

Sub 跳步填写银行卡信息(start_row, start_col, ar)
    For x = 0 To UBound(ar)
        ar_res(start_row, start_col) = ar(x)
        start_col = start_col + 5
    Next
End Sub

Sub 输出项目信息()
    For x = 1 To UBound(ar_res)
        If dic_项目信息.exists(ar_res(x, 1)) Then
            t = dic_项目信息(ar_res(x, 1))
            If InStr(t(0), ",") > 0 Then
                tem0 = Split(t(0), ",")
                Call 跳步填写银行卡信息(x, 9, tem0)
                tem1 = Split(t(1), ",")
                Call 跳步填写银行卡信息(x, 10, tem1)
                tem2 = Split(t(2), ",")
                Call 跳步填写银行卡信息(x, 11, tem2)
                tem3 = Split(t(3), ",")
                Call 跳步填写银行卡信息(x, 13, tem3)
            Else
                ar_res(x, 9) = t(0) '卡号
                ar_res(x, 10) = t(1) '银行名称
                ar_res(x, 11) = t(2) '金额
                ar_res(x, 13) = t(3) '项目
            End If
        End If
    Next
End Sub

Sub 项目信息写入字典()
    Set dic_项目信息 = CreateObject("scripting.dictionary")
    For x = 1 To UBound(ar_src)
        If Not dic_项目信息.exists(ar_src(x, 1)) Then
            dic_项目信息(ar_src(x, 1)) = Array(ar_src(x, 3), ar_src(x, 4), ar_src(x, 6), ar_src(x, 9), 1)
        Else
            k = dic_项目信息(ar_src(x, 1))
            k(0) = k(0) & "," & ar_src(x, 3)
            k(1) = k(1) & "," & ar_src(x, 4)
            k(2) = k(2) & "," & ar_src(x, 6)
            k(3) = k(3) & "," & ar_src(x, 9)
            k(4) = k(4) + 1
            dic_项目信息(ar_src(x, 1)) = k
        End If
    Next
End Sub

Sub 计算本月交税合计金额()
    For x = 1 To UBound(ar_res)
        受雇年度 = Year(ar_res(x, 3))
        受雇月份 = Month(ar_res(x, 3))
        当前年度 = Year(Now())
        当前月份 = Month(Now())
        '        本月工资 = dic_工资求和(ar_res(x, 1))
        '        申报工资累计 = ar_res(x, 6)
        If 受雇年度 = 当前年度 Then
            月份系数 = 当前月份 - 受雇月份 + 1
        ElseIf 受雇年度 < 当前年度 Then
            月份系数 = 当前月份
        End If
        If ar_res(x, 5) + ar_res(x, 6) - 5000 * 月份系数 < 0 Then
            计税金额 = 0
        Else
            计税金额 = ar_res(x, 5) + ar_res(x, 6) - 5000 * 月份系数
        End If
        res_tem = 按阶梯计算个税(计税金额, 月份系数)
        If res_tem > 0 Then
            ar_res(x, 8) = res_tem - ar_res(x, 7)
        Else
            ar_res(x, 8) = 0
        End If
        '        ar_res(x, 8) = 按阶梯计算个税(计税金额, 月份系数)
    Next
End Sub

Function 按阶梯计算个税(s, 系数)
    If s <= 3000 * 系数 Then
        按阶梯计算个税 = s * 0.03
    ElseIf s <= 12000 * 系数 Then
        按阶梯计算个税 = s * 0.1 - 210 * 系数
    ElseIf s <= 25000 * 系数 Then
        按阶梯计算个税 = s * 0.2 - 1410 * 系数
    ElseIf s <= 35000 * 系数 Then
        按阶梯计算个税 = s * 0.25 - 2660 * 系数
    ElseIf s <= 55000 * 系数 Then
        按阶梯计算个税 = s * 0.3 - 4410 * 系数
    ElseIf s <= 80000 * 系数 Then
        按阶梯计算个税 = s * 0.35 - 7160 * 系数
    ElseIf s > 80000 * 系数 Then
        按阶梯计算个税 = s * 0.45 - 15160 * 系数
    End If
End Function

Function 日期比较器(d1, d2)
    d1 = Replace(d1, "-", "/")
    d2 = Replace(d2, ".", "/")
    日期比较器 = DateDiff("d", d1, d2)
End Function

Sub 计算合计已申报金额和合计已交税()
    Set dic_已交税额 = CreateObject("scripting.dictionary")
    With Sheet3
        arr = .Range("a1").CurrentRegion
        For x = 5 To UBound(arr)
            受雇日期 = dic_受雇日期(arr(x, 4))
            申报日期 = arr(x, 1)
            If 日期比较器(受雇日期, 申报日期) >= 0 Then
                If Not dic_已交税额.exists(arr(x, 4)) Then
                    dic_已交税额(arr(x, 4)) = Array(arr(x, 8), arr(x, 40))
                Else
                    k = dic_已交税额(arr(x, 4))
                    k(0) = k(0) + arr(x, 8)
                    k(1) = k(1) + arr(x, 40)
                    dic_已交税额(arr(x, 4)) = k
                End If
            End If
        Next
        For x = 1 To UBound(ar_res)
            If dic_已交税额.exists(ar_res(x, 1)) Then
                t = dic_已交税额(ar_res(x, 1))
                ar_res(x, 6) = t(0)
                ar_res(x, 7) = t(1)
            End If
        Next
    End With
End Sub

Sub 清空()
    With Sheet4
        .Range("b3:x65535").ClearContents
    End With
End Sub

Sub 在结果数组填写受雇日期和人员状态()
    With Sheet4
        .Range("b:b").NumberFormatLocal = "@"
        .Range("d:d").NumberFormatLocal = "@"
        .Range("j:j").NumberFormatLocal = "@"
        r = .Cells(.Rows.Count, 1).End(xlUp).Row
        ar_res = .Range("b3:az" & r)
        For x = 1 To UBound(ar_res)
            If dic.exists(ar_res(x, 1)) Then
                t = dic(ar_res(x, 1))
                ar_res(x, 3) = Format(t(1), "YYYY-MM-dd")
                ar_res(x, 4) = t(0)
            End If
            If dic_工资求和.exists(ar_res(x, 1)) Then
                t = dic_工资求和(ar_res(x, 1))
                ar_res(x, 5) = t
            End If
        Next
    End With
End Sub

Sub 获取原始数据_身份证号码和姓名()
    Set dic_工资求和 = CreateObject("scripting.dictionary")
    Set dic_身份证号 = CreateObject("scripting.dictionary")
    With Sheet1
        r = .Cells(.Rows.Count, 1).End(xlUp).Row
        ar_src = .Range("b2:az" & r)
        '工资求和
        For x = 1 To UBound(ar_src)
            dic_工资求和(ar_src(x, 1)) = dic_工资求和(ar_src(x, 1)) + ar_src(x, 6) '工资单上 本月收入
            dic_身份证号(ar_src(x, 1)) = ar_src(x, 2)
        Next
    End With
    With Sheet4
        .Range("b:b").NumberFormatLocal = "@"
        '        .Range("b3").Resize(UBound(ar_src), 1) = Application.Index(ar_src, , 1)
        '        .Range("c3").Resize(UBound(ar_src), 1) = Application.Index(ar_src, , 2)
        .Range("b3").Resize(dic_身份证号.Count, 1) = Application.Transpose(dic_身份证号.keys)
        .Range("c3").Resize(dic_身份证号.Count, 1) = Application.Transpose(dic_身份证号.items)
    End With
End Sub

Sub 结果输出()
    With Sheet4
        .Range("b3").Resize(UBound(ar_res), UBound(ar_res, 2)) = ar_res
    End With
End Sub

Sub 受雇日期和人员状态写入字典()
    With Sheet2
        Set dic = CreateObject("scripting.dictionary")
        ar = .Range("a1").CurrentRegion
        For x = 2 To UBound(ar)
            s_人员状态 = ar(x, 7)
            s_受雇日期 = ar(x, 11)
            dic(ar(x, 4)) = Array(s_人员状态, s_受雇日期)
        Next
    End With
End Sub