[已解决]还请老师帮忙看看，为啥有个村的统计不出来？

wdqinweiyu

还请老师帮忙看看，为啥有个村的统计不出来？ 条件统计20120802a.zip (31.31 KB, 下载次数: 51)

2012-8-6 16:05 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

suye1010

2012-8-7 14:24

这句代码有问题，如果这个村只有一个人参保的话，在你去除最后一个","后，这个村的数据就不满足条件了，所以这个村就不统计了
If InStr(t(i), ",") Then
        aa = Split(t(i), ",")

1. Sub lqxs()
   
2. Dim Arr, i&, aa, j&, Brr, z, nl
   
3. Dim d, k, t
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Sheet1.Activate
   
6. Arr = Sheet2.[a1].CurrentRegion
   
7. For i = 3 To UBound(Arr)
   
8. d(Arr(i, 16)) = d(Arr(i, 16)) & i & ","
   
9. Next
   
10. k = d.keys
    
11. t = d.items
    
12. ReDim Brr(1 To d.Count, 1 To 24) '你特殊参保在第24列，定义数组的时候列数少于24当然不能显示出来
    
13. For i = 0 To UBound(k)
    
14. Brr(i + 1, 1) = i + 1
    
15. Brr(i + 1, 2) = k(i)
    
16. ' t(i) = Left(t(i), Len(t(i)) - 1) 这些可以不用先处理
    
17. ' If InStr(t(i), ",") Then
    
18. aa = Split(t(i), ",")
    
19. For j = 0 To UBound(aa) - 1 '在这里不要去最后一个元素即相当于去除最后一个逗号
    
20. z = Arr(aa(j), 4)
    
21. If Val(Mid(z, 17, 1)) Mod 2 = 1 Then
    
22. Brr(i + 1, 4) = Brr(i + 1, 4) + 1
    
23. Else
    
24. Brr(i + 1, 5) = Brr(i + 1, 5) + 1
    
25. End If
    
26. Brr(i + 1, 3) = Brr(i + 1, 3) + 1
    
27. nl = DateSerial(Mid(z, 7, 4), Mid(z, 11, 2), Mid(z, 13, 2))
    
28. nl = DateDiff("yyyy", nl, Date)
    
29. Select Case nl
    
30. Case 16 To 35
    
31. Brr(i + 1, 7) = Brr(i + 1, 7) + 1
    
32. Case 36 To 44
    
33. Brr(i + 1, 8) = Brr(i + 1, 8) + 1
    
34. Case 45 To 59
    
35. Brr(i + 1, 9) = Brr(i + 1, 9) + 1
    
36. Case 60 To 69
    
37. Brr(i + 1, 10) = Brr(i + 1, 10) + 1
    
38. Case 70 To 79
    
39. Brr(i + 1, 11) = Brr(i + 1, 11) + 1
    
40. Case 80 To 89
    
41. Brr(i + 1, 12) = Brr(i + 1, 12) + 1
    
42. Case Is >= 90
    
43. Brr(i + 1, 13) = Brr(i + 1, 13) + 1
    
44. End Select
    
45. Brr(i + 1, 6) = Brr(i + 1, 6) + 1
    
46. Select Case Arr(aa(j), 9)
    
47. Case 100
    
48. Brr(i + 1, 14) = Brr(i + 1, 14) + 1
    
49. Case 200
    
50. Brr(i + 1, 15) = Brr(i + 1, 15) + 1
    
51. Case 300
    
52. Brr(i + 1, 16) = Brr(i + 1, 16) + 1
    
53. Case 400
    
54. Brr(i + 1, 17) = Brr(i + 1, 17) + 1
    
55. Case 500
    
56. Brr(i + 1, 18) = Brr(i + 1, 18) + 1
    
57. End Select
    
58. If Arr(aa(j), 12) <> "" Then Brr(i + 1, 24) = Brr(i + 1, 24) + 1 '这里是处理特殊参保人群
    
59. Next
    
60. ' End If
    
61. Next
    
62. [A7].Resize(100, 100).ClearContents
    
63. [A7].Resize(UBound(Brr, 1), UBound(Brr, 2)) = Brr
    
64. End Sub
    

复制代码

跳转到最佳答案楼层

dongqing1998

做个示例文件就行，现在这么多的数据看着就头痛了。

gdsgzhrsh

dongqing1998 发表于 2012-8-7 00:28
做个示例文件就行，现在这么多的数据看着就头痛了。

董老板，怎么这么早

dongqing1998

gdsgzhrsh 发表于 2012-8-7 08:47
董老板，怎么这么早

我是一直在加班。

wdqinweiyu

好的，我重新做一下哈。

suye1010

这句代码有问题，如果这个村只有一个人参保的话，在你去除最后一个","后，这个村的数据就不满足条件了，所以这个村就不统计了
If InStr(t(i), ",") Then
        aa = Split(t(i), ",")

1. Sub lqxs()
   
2. Dim Arr, i&, aa, j&, Brr, z, nl
   
3. Dim d, k, t
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Sheet1.Activate
   
6. Arr = Sheet2.[a1].CurrentRegion
   
7. For i = 3 To UBound(Arr)
   
8. d(Arr(i, 16)) = d(Arr(i, 16)) & i & ","
   
9. Next
   
10. k = d.keys
    
11. t = d.items
    
12. ReDim Brr(1 To d.Count, 1 To 24) '你特殊参保在第24列，定义数组的时候列数少于24当然不能显示出来
    
13. For i = 0 To UBound(k)
    
14. Brr(i + 1, 1) = i + 1
    
15. Brr(i + 1, 2) = k(i)
    
16. ' t(i) = Left(t(i), Len(t(i)) - 1) 这些可以不用先处理
    
17. ' If InStr(t(i), ",") Then
    
18. aa = Split(t(i), ",")
    
19. For j = 0 To UBound(aa) - 1 '在这里不要去最后一个元素即相当于去除最后一个逗号
    
20. z = Arr(aa(j), 4)
    
21. If Val(Mid(z, 17, 1)) Mod 2 = 1 Then
    
22. Brr(i + 1, 4) = Brr(i + 1, 4) + 1
    
23. Else
    
24. Brr(i + 1, 5) = Brr(i + 1, 5) + 1
    
25. End If
    
26. Brr(i + 1, 3) = Brr(i + 1, 3) + 1
    
27. nl = DateSerial(Mid(z, 7, 4), Mid(z, 11, 2), Mid(z, 13, 2))
    
28. nl = DateDiff("yyyy", nl, Date)
    
29. Select Case nl
    
30. Case 16 To 35
    
31. Brr(i + 1, 7) = Brr(i + 1, 7) + 1
    
32. Case 36 To 44
    
33. Brr(i + 1, 8) = Brr(i + 1, 8) + 1
    
34. Case 45 To 59
    
35. Brr(i + 1, 9) = Brr(i + 1, 9) + 1
    
36. Case 60 To 69
    
37. Brr(i + 1, 10) = Brr(i + 1, 10) + 1
    
38. Case 70 To 79
    
39. Brr(i + 1, 11) = Brr(i + 1, 11) + 1
    
40. Case 80 To 89
    
41. Brr(i + 1, 12) = Brr(i + 1, 12) + 1
    
42. Case Is >= 90
    
43. Brr(i + 1, 13) = Brr(i + 1, 13) + 1
    
44. End Select
    
45. Brr(i + 1, 6) = Brr(i + 1, 6) + 1
    
46. Select Case Arr(aa(j), 9)
    
47. Case 100
    
48. Brr(i + 1, 14) = Brr(i + 1, 14) + 1
    
49. Case 200
    
50. Brr(i + 1, 15) = Brr(i + 1, 15) + 1
    
51. Case 300
    
52. Brr(i + 1, 16) = Brr(i + 1, 16) + 1
    
53. Case 400
    
54. Brr(i + 1, 17) = Brr(i + 1, 17) + 1
    
55. Case 500
    
56. Brr(i + 1, 18) = Brr(i + 1, 18) + 1
    
57. End Select
    
58. If Arr(aa(j), 12) <> "" Then Brr(i + 1, 24) = Brr(i + 1, 24) + 1 '这里是处理特殊参保人群
    
59. Next
    
60. ' End If
    
61. Next
    
62. [A7].Resize(100, 100).ClearContents
    
63. [A7].Resize(UBound(Brr, 1), UBound(Brr, 2)) = Brr
    
64. End Sub
    

复制代码

wdqinweiyu

就是要这种效果。

wdqinweiyu

还有问题要请教下