从个人所得税专项扣除信息表中提取资料。

hyz00001

2019年实施的新个税方案需要先申报个人所得税专项扣除信息。
申报之后可以下载我们申报的内容。
这个巨集是专门用来从下载后的信息表中提取资料。分享给大家。
首先是自己把需要整理的申报表放在一个workbook中。然后运行这个代码。

1. Sub 个税提取()
   
2.     Dim br(65536, 20)
   
3.     Dim a, b, c, x, y, r, rx, ry, n, item
   
4.     For Each sht In Sheets
   
5.         sht.Activate
   
6.         If [a2] <> "个人所得税专项附加扣除信息表" Then GoTo nextsht
   
7.         rx = Cells(Rows.Count, 1).End(xlUp).Row
   
8.         ry = Cells(5, Columns.Count).End(xlToLeft).Column
   
9.         ar = Range(Cells(1, 1), Cells(rx, ry))
   
10.         item = item + 1
    
11.         br(item - 1, 0) = ar(4, 2) '姓名
    
12.         br(item - 1, 1) = "'" & ar(4, 6) '身份证
    
13.         br(item - 1, 2) = "'" & ar(5, 7) '手机号码
    
14.         '子女扣除
    
15.         n = Application.CountIf(Cells, "本人扣除比例")
    
16.         For c = 1 To n
    
17.             br(item - 1, 3) = br(item - 1, 3) + 1000 * ar(10 + c * 4, 7) / 100
    
18.             br(item - 1, 4) = br(item - 1, 4) & "," & ar(7 + c * 4, 3)
    
19.         Next c
    
20.             br(item - 1, 4) = Mid(br(item - 1, 4), 2, 99)  '"共" & c & "个小孩，他们是:" &
    
21.         '教育扣除
    
22.         c = Application.Match("当前继续教育起始时间", Application.Index(ar, , 2), 0)
    
23.         If ar(c, 3) <> "" Then br(item - 1, 5) = 400: br(item - 1, 6) = ar(c, 7) & ar(c, 3)
    
24.         '住房贷款
    
25.         c = Application.Match("房屋证书号码", Application.Index(ar, , 6), 0)
    
26.         If ar(c + 1, 7) = "是" Then br(item - 1, 7) = 500: br(item - 1, 8) = ar(c + 4, 7)
    
27.         If ar(c + 1, 7) = "否" Then br(item - 1, 7) = 1000: br(item - 1, 8) = ar(c + 4, 7)
    
28.         '租房
    
29.         c = Application.Match("租赁期止", Application.Index(ar, , 6), 0)
    
30.         If ar(c, 7) <> "" Then br(item - 1, 9) = 1500: br(item - 1, 10) = ar(c - 3, 3)
    
31.         '赡养老人
    
32.         c = Application.Match("本年度月扣除金额", Application.Index(ar, , 6), 0)
    
33.         If ar(c, 7) <> "" Then br(item - 1, 11) = ar(c, 7): br(item - 1, 12) = ar(c, 2)
    
34.         '大病扣除
    
35.         c = Application.Match("与纳税人关系", Application.Index(ar, , 6), 0)
    
36.         If ar(c - 1, 3) <> "" Then br(item - 1, 13) = ar(c, 5): br(item - 1, 14) = ar(c - 1, 3)
    
37.         '合计扣除
    
38.         br(item - 1, 15) = br(item - 1, 3) + br(item - 1, 5) + br(item - 1, 7) + br(item - 1, 9) + br(item - 1, 11) + br(item - 1, 13)
    
39. nextsht:
    
40.     Next sht
    
41.     Sheets("1").Activate
    
42.     Sheets.Add: [a2].Resize(item, 16) = br: [a1].Resize(1, 16) = Split("姓名,身份证,手机,子女扣除,子女,教育扣除,教育,贷款扣除,贷款银行,租房扣除,出租房,赡养扣除,是否独生子女,大病扣除,大病人,合计扣除", ",")
    
43. ' Stop
    
44. End Sub

复制代码

补充内容 (2019-1-22 20:52):
那个比较好用的模板在25楼，谁能帮忙把那个附件提到第一页来，让大家不必走弯路。
希望我的努力能帮助到大家。

补充内容 (2019-1-26 17:01):
刚看了个人所得税的系统，系统已经更新，可以从系统直接引出已申报数据。

jjmysjg

有附件就更好了

lhsh36183

感谢楼主奉献精神，如能上传附件，才能得以真正的分享。

苏阳湖wzy

建议楼主分享附件！

hyz00001

附件就是国税局申报之后可以引出的《个人所得税专项附加扣除信息表》表，因为涉及到公司大部分人的数据，不能上传附件，请见谅，如果用以上代码不能再你家的表中正确取数，建议在这里由你上传附件，我来提供协助。谢谢！

lhsh36183

hyz00001 发表于 2019-1-11 09:13
附件就是国税局申报之后可以引出的《个人所得税专项附加扣除信息表》表，因为涉及到公司大部分人的数据，不 ...

请问是在一个文件夹中放入N个《个人所得税专项附加扣除信息表》吗？这个提取资料的表是单独的吗？具体怎么设置和操作务必请楼主加以说明。这样才能达到分享的目的。

spark999

首光非常感谢楼主的分享！及时地解决我目前的问题。

执行中  发现类似     c = Application.Match("当前继续教育起始时间", Application.Index(ar, , 2), 0) 这样的都是出错，迟些我把我的附件发上来。

目前我只好把其改成 for i ＝2 to 最后一行，if cells（i,2）="当前续教育起始时间" then c=i 逐行查找的方法，实现找到c对应的行号，但是执行时太慢了，不如内存数组内查找快。我是将某一个目录下从个税糸统汇出的个人信息，转换计算后再导入到一个总表，79个文件要差不多1分钟才完成。

xuewuyu

楼主代码为什么在2013版里运行会提示下标越界？

qq156059757

xuewuyu 发表于 2019-1-13 21:49
楼主代码为什么在2013版里运行会提示下标越界？

遇到同样的问题
下标越界
office 2013

summer201401

麻烦帮忙看一下，这个程序无法运行。
另外，关于采集表有几点实际困难需要解决
1. 从系统导出的采集表，因每个人的实际填写中的子女、老人、共同赡养人人数不同，而使得每个人的表格行数来说就不一致。
2. 系统导出的采集表是每个人一个workbook，而不是sheet表，能否将汇总程序改一下。

详细见附件，多谢