个税申报数据清洗

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

Sub main()
    清空
    获取原始数据_身份证号码和姓名
    受雇日期和人员状态写入字典
    在结果数组填写受雇日期和人员状态
    计算合计已申报金额和合计已交税
    计算本月交税合计金额
    项目信息写入字典
    输出项目信息
    计算分摊税金
    结果输出
    销毁
    MsgBox "OK"
End Sub
Sub 销毁()
    Set dic = Nothing
    Set dic_工资求和 = Nothing
    Set dic_已交税额 = Nothing
    Set dic_项目信息 = Nothing
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)
        If ar_res(x, 5) - 5000 < 0 Then
            计税金额 = 0
        Else
            计税金额 = ar_res(x, 5) - 5000
        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

Sub 计算合计已申报金额和合计已交税()
    Set dic_已交税额 = CreateObject("scripting.dictionary")
    With Sheet3
        arr = .Range("a1").CurrentRegion
        For x = 5 To UBound(arr)
            If Not dic_已交税额.exists(arr(x, 4)) Then
                dic_已交税额(arr(x, 4)) = Array(arr(x, 8), arr(x, 39))
            Else
                k = dic_已交税额(arr(x, 4))
                k(0) = k(0) + arr(x, 8)
                k(1) = k(1) + arr(x, 39)
                dic_已交税额(arr(x, 4)) = k
            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("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("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