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

cymnet

qq156059757 发表于 2019-1-16 17:13
注释掉 是可以运行了  只是运行出来的结果是错误的
需要的信息丢失了我刚才用同事的电脑试了一下  wps竟 ...

楼主有什么办法解决吗？我的offer2007的，我也试一下用wps可以运行2007的就不可以运行

qq156059757

cymnet 发表于 2019-1-17 10:15
楼主有什么办法解决吗？我的offer2007的，我也试一下用wps可以运行2007的就不可以运行

这位兄弟
装个wps吧 ，很简单
我就是这么解决的
反正wps跟office可以共存

hyz00001

ezjahz 发表于 2019-1-16 14:00
您好！
     您那个创建“目录”好像有点问题，现点一次就生成一张新“目录”表。是否能修改成在原目录 ...

这个是很早之前编写的代码，当时的想法是留下全部的数据。
如果你不会看代码就直接把目录删除了再添加目录。
如果你会看代码就可以把里面一个sheets.add 的相关代码删除，更改成为：sheets("目录").activate .

苏阳湖wzy

l楼主，你好！我的2003版也是出现类型不匹配，运行出错误出现在：
c = Application.Match("当前继续教育起始时间", Application.Index(ar, , 2), 0) 处

请你再优化一下代码呢，谢谢！！！

ezjahz

hyz00001 发表于 2019-1-18 11:35
这个是很早之前编写的代码，当时的想法是留下全部的数据。
如果你不会看代码就直接把目录删除了再添加目 ...

好的，谢谢！

ezjahz

hyz00001 发表于 2019-1-18 11:35
这个是很早之前编写的代码，当时的想法是留下全部的数据。
如果你不会看代码就直接把目录删除了再添加目 ...

没找到 sheets.add

ouyli

个税信息汇总-放同一文件夹下.zip (23.45 KB, 下载次数: 76)

2019-1-19 12:28 上传

点击文件名下载附件

    修改了下。用查找的方式去定位。另外租房写死了按一线城市1500元扣除。其他城市还有1100元和800元的呢。
“类型不匹配 把ar 换回 Range(Cells(1, 1), Cells(rx, ry)) 好像可以解决吧。”

乐乐2006201505

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

http://club.excelhome.net/thread-1457118-1-1.html是不是和这个帖子中附件一样？这个帖子中的很好。

hyz00001

感谢各位。
今天又想到一个类模块，可以用来在数组中做模糊查询或者精确查询。返回查找到数据的位置的一个数组。

测试的代码如下：

1. Sub teee()
   
2. Dim dw As New 数组
   
3. rx = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
   
4. ry = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
   
5. ar = Range(Cells(1, 1), Cells(rx, ry))
   
6. n = dw.精确位置("贺有志", ar)
   
7. Stop
   
8. End Sub

复制代码

类模块的代码如下：

1. Dim kw As New 数组
   
2. Dim rx, ry, ar, y, n, 次数
   
3. Dim c(65536)
   
4. ar = 数组
   
5. For y = 1 To UBound(ar, 2)
   
6. n = Application.Match("*" & 查询内容 & "*", Application.Index(ar, , y), 0)
   
7. If IsError(n) Then n = 0
   
8. If n > 0 Then 次数 = 次数 + 1: c(次数) = n & "," & y
   
9. Next y
   
10. If 第几次出现 = "" Then 第几次出现 = 1
    
11. If 次数 > 0 Then
    
12.     模糊位置 = Split(c(第几次出现), ",")
    
13. Else
    
14.     模糊位置 = Array(0, 0)
    
15. End If
    
16. End Function
    
17. Function 精确位置(查询内容 As String, 数组 As Variant, Optional 第几次出现 As String) As Variant
    
18. Dim kw As New 数组
    
19. Dim rx, ry, ar, y, n, 次数
    
20. Dim c(65536)
    
21. ar = 数组
    
22. For y = 1 To UBound(ar, 2)
    
23. n = Application.Match(查询内容, Application.Index(ar, , y), 0)
    
24. If IsError(n) Then n = 0
    
25. If n > 0 Then 次数 = 次数 + 1: c(次数) = n & "," & y
    
26. Next y
    
27. If 第几次出现 = "" Then 第几次出现 = 1
    
28. If 次数 > 0 Then
    
29.     精确位置 = Split(c(第几次出现), ",")
    
30. Else
    
31.     精确位置 = Array(0, 0)
    
32. End If
    
33. End Function
    
34. 
    
35. 
    

复制代码

自己水平有限，但求不玷污EXCEL就好。

spark999

qq156059757 发表于 2019-1-14 16:44
这位大神 你的附件什么时候发啊
兄弟们等着膜拜呢

不好意思，来了来了，首先不是大神，也是小白一个。

1.将从税务系统导出的文件夹，改名‘tax’.
2.Total.xls 为本次从‘tax’文件夹下的信息汇总档。