人力报表,人员信息按照年龄范围与工龄范围汇总

1588078/37

表名	入职日截止	file:///C:/Users/ADMINI~1/AppData/Local/Temp/msohtmlclip1/01/clip_image001.gif   属性-部门	参数
在职人员年龄分布		后勤单位-总经理室,生产单位-工程技术部,生产单位-长晶生产部,生产单位-晶圆生产部,生产单位-动力设备部,生产单位-生管部,生产单位-品保部,后勤单位-采购部,后勤单位-财务部,后勤单位-人力资源部,后勤单位-总经办,后勤单位-业务部,后勤单位-基建处	20岁以下,21-25岁,26-30岁,31-35岁,36-40岁,41-50岁,51岁以上
在职人员司龄分布		后勤单位-总经理室,生产单位-工程技术部,生产单位-长晶生产部,生产单位-晶圆生产部,生产单位-动力设备部,生产单位-生管部,生产单位-品保部,后勤单位-采购部,后勤单位-财务部,后勤单位-人力资源部,后勤单位-总经办,后勤单位-业务部,后勤单位-基建处	0-3个月,4-16个月,7-12个月,1-2年,2-3年,3-5年,5年以上

如表中,年龄与工龄按照参数列的条件进行统计.

1. Sub 新建工作表()
   
2. On Error Resume Next
   
3. 
   
4.     tmp = InputBox("请在文本框中输入新建工作表名称：" & Chr(13) & Chr(13) & "按【确定】增加，否则请按【取消】。", "〖点解点解〗")
   
5.     If tmp = "" Then tmp = Sheet3.Name
   
6.     For Each n In Sheets
   
7. If tmp = n.Name Then
   
8. tmp = n.Name: k = 1
   
9. Exit For
   
10. End If
    
11. Next
    
12. If k <> 1 Then
    
13. Sheets.Add After:=Sheets(Sheets.Count)
    
14. ActiveSheet.Name = tmp
    
15. End If
    
16. 
    
17. With Sheets(tmp)
    
18. .Cells.Clear
    
19. .Cells.RowHeight = Cells(2, 5)
    
20. .Cells.ColumnWidth = Cells(2, 6)
    
21. .Cells.HorizontalAlignment = xlCenter
    
22. .Cells.VerticalAlignment = xlCenter
    
23. End With
    
24. Dim c As Range
    
25. Dim arr
    
26. arr = Sheet2.UsedRange
    
27. Dim d(1 To 6) As Object
    
28. Set dic = CreateObject("Scripting.Dictionary")
    
29. Set d(1) = CreateObject("Scripting.Dictionary")
    
30. Set d(2) = CreateObject("Scripting.Dictionary")
    
31. Set d(3) = CreateObject("Scripting.Dictionary")
    
32. Set d(4) = CreateObject("Scripting.Dictionary")
    
33. Set d(5) = CreateObject("Scripting.Dictionary")
    
34. Set d(6) = CreateObject("Scripting.Dictionary")
    
35. For i = 2 To UBound(arr)
    
36. If arr(i, 17) = "中专" Or arr(i, 17) = "高中" Then
    
37. arr(i, 17) = "高中（含中专）"
    
38. ElseIf IsNumeric(Application.Match(arr(i, 17), Split(Cells(4, 4), ","), 0)) Then
    
39. arr(i, 17) = arr(i, 17)
    
40. Else: arr(i, 17) = "高中以下"
    
41. End If
    
42. arr(i, 22) = Val(Split(arr(i, 22), "年")) * 12 + Val(Split(Split(arr(i, 22), "年")(1), "月"))
    
43. 
    
44. dic(arr(i, 4)) = dic(arr(i, 4)) + 1
    
45. d(1)(arr(i, 2) & arr(i, 4)) = d(1)(arr(i, 2) & arr(i, 4)) + 1 '年龄
    
46. d(2)(arr(i, 22) & arr(i, 4)) = d(2)(arr(i, 22) & arr(i, 4)) + 1 '司龄
    
47. d(3)(arr(i, 17) & arr(i, 4)) = d(3)(arr(i, 17) & arr(i, 4)) + 1 '学历
    
48. d(4)(arr(i, 12) & arr(i, 4)) = d(4)(arr(i, 12) & arr(i, 4)) + 1  '岗位
    
49. d(5)(arr(i, 6) & arr(i, 4)) = d(5)(arr(i, 6) & arr(i, 4)) + 1   '职等
    
50. d(6)(arr(i, 14) & arr(i, 4)) = d(6)(arr(i, 14) & arr(i, 4)) + 1 '性别
    
51. Next
    
52. m = 5
    
53. For i = 2 To 7
    
54. aj = Split(Cells(i, 3), ",")
    
55. bj = Split(Cells(i, 4), ",")
    
56. ReDim sj(UBound(aj))
    
57. For j = 0 To UBound(aj)
    
58. sj(j) = Split(aj(j), "-")
    
59. Next
    
60. With Sheets(tmp)
    
61. .Cells(m - 3, 2) = Cells(i, 1)
    
62. .Cells(m - 3, 2).Font.Bold = True
    
63. .Cells(m - 2, 1) = Split(Cells(1, 3), "-")(0)
    
64. .Cells(m - 2, 2) = Split(Cells(1, 3), "-")(1)
    
65. .Range(.Cells(m - 2, 1), .Cells(m - 1, 1)).Merge
    
66. .Range(.Cells(m - 2, 2), .Cells(m - 1, 2)).Merge
    
67. With .Cells(m, 1).Resize(UBound(sj) + 1, 2)
    
68. .Value = Application.Transpose(Application.Transpose(sj))
    
69. End With
    
70. With .Cells(m, 2).Resize(UBound(sj) + 1, 1)
    
71. .Font.Bold = True
    
72. .Interior.ColorIndex = Cells(2, 7)
    
73. End With
    
74. For j = 0 To UBound(bj)
    
75. .Cells(m - 2, j * 2 + 3) = bj(j)
    
76. .Range(.Cells(m - 2, j * 2 + 3), .Cells(m - 2, j * 2 + 4)).Merge
    
77. .Cells(m - 1, j * 2 + 3) = "人数"
    
78. .Cells(m - 1, j * 2 + 4) = "占比"
    
79. Next
    
80. .Cells(m - 2, 3 + (UBound(bj) + 1) * 2) = "合计"
    
81. .Range(.Cells(m - 2, 3 + (UBound(bj) + 1) * 2), .Cells(m - 1, 3 + (UBound(bj) + 1) * 2)).Merge
    
82. .Cells(m - 2, 4 + (UBound(bj) + 1) * 2) = "占比"
    
83. .Range(.Cells(m - 2, 4 + (UBound(bj) + 1) * 2), .Cells(m - 1, 4 + (UBound(bj) + 1) * 2)).Merge
    
84. .Cells(m + UBound(sj) + 1, 1) = "合计"
    
85. .Range(.Cells(m + UBound(sj) + 1, 1), .Cells(m + UBound(sj) + 1, 2)).Merge
    
86. Set c = .Range(.Cells(m - 2, 1), .Cells(m + UBound(sj) + 1, 4 + (UBound(bj) + 1) * 2))
    
87. c.Borders.LineStyle = xlContinuous
    
88. c.BorderAround xlContinuous, xlMedium
    
89. .Range(.Cells(m - 2, 1), .Cells(m - 1, 4 + (UBound(bj) + 1) * 2)).Interior.ColorIndex = Cells(2, 8)
    
90. crr = .Range(.Cells(m - 2, 1), .Cells(m + UBound(sj) + 1, 4 + (UBound(bj) + 1) * 2))
    
91. For x = 3 To UBound(crr) - 1
    
92. For y = 3 To UBound(crr, 2) - 3 Step 2
    
93. crr(x, y) = d(i - 1)(crr(1, y) & crr(x, 2))
    
94. crr(x, y + 1) = Format(crr(x, y) / dic(crr(x, 2)), "0.00%")
    
95. crr(x, UBound(crr, 2) - 1) = crr(x, UBound(crr, 2) - 1) + crr(x, y)
    
96. crr(UBound(crr), y) = crr(UBound(crr), y) + crr(x, y)
    
97. crr(UBound(crr), UBound(crr, 2) - 1) = crr(UBound(crr), UBound(crr, 2) - 1) + crr(x, y)
    
98. Next
    
99. Next
    
100. For x = 3 To UBound(crr)
     
101. crr(x, UBound(crr, 2)) = Format(crr(x, UBound(crr, 2) - 1) / Val(crr(UBound(crr), UBound(crr, 2) - 1)), "0.00%")
     
102. Next
     
103. .Cells(m - 2, 1).Resize(UBound(crr), UBound(crr, 2)) = crr
     
104. End With
     
105. m = m + UBound(aj) + 6
     
106. Next
     
107. Cells(10, 3) = arr(6, 22)
     
108. Cells(11, 3) = Val(Split(arr(6, 22), "年").Value)
     
109. Cells(12, 3) = Val(Split(Split(arr(12, 22), "年")(1), "月"))
     
110. End Sub

复制代码

1588078/37

如表中,年龄与工龄按照参数列的条件进行统计
d(1)(arr(i, 2) & arr(i, 4)) = d(1)(arr(i, 2) & arr(i, 4)) + 1 '年龄
d(2)(arr(i, 22) & arr(i, 4)) = d(2)(arr(i, 22) & arr(i, 4)) + 1 '司龄
这报表自己做到这两天,没有想出好的方法.想是取每个条件参数的后面最大的数字,循环减前面的单元格,那样就固定,有更改就能以调整

蓝桥玄霜

请见代码。

1588078/37

蓝版出手手就是最佳答案了.

1588078/37

蓝桥玄霜 发表于 2015-11-29 11:28
请见代码。

rng 是从目录中第四列D2的值生成的,不是固定的. 也不固定是这年龄范围的.

1588078/37

蓝桥玄霜 发表于 2015-11-29 11:28
请见代码。

谢谢蓝版,我照你的方法改下,谢谢.

1588078/37

22列,工龄列,怎么也无法提取年和月的数字,提出来都是文本数据,转换不了数值,

1588078/37

z = arr(i, 22)
Trim(Mid(Split(z, "年")(1), 1, Len(Split(z, "年")(1)) - 1))
取月份的数值,
年份的数值怎么也弄不出来

1588078/37

Mid(z, 1, Len(z) - 1 - Len(Split(arr(i, 22), "年")(1)))
年份用这样取值,有什么简单的可代替吗?

1588078/37

蓝桥玄霜 发表于 2015-11-29 11:28
请见代码。

1. Function npld(n)
   
2. 
   
3. Dim x As String
   
4. bj = Split(Sheet1.Cells(2, 4), ",")
   
5. For i = 0 To UBound(bj)
   
6. x = bj(i)
   
7. bj(i) = MyGet(x, 0)
   
8. Next
   
9. Select Case n
   
10. Case Is <= Val(bj(0))
    
11. col = 3
    
12. Case Val(Split(bj(1), "-")) To Val(Split(bj(1), "-")(1))
    
13. col = 5
    
14. Case Val(Split(bj(2), "-")) To Val(Split(bj(2), "-")(1))
    
15. col = 7
    
16. Case 31 To 35
    
17. col = 9
    
18. Case 36 To 40
    
19. col = 11
    
20. Case 41 To 50
    
21. col = 13
    
22. Case Is >= 51
    
23. col = 15
    
24. End Select
    
25. End Function

复制代码

Case Is <= Val(bj(0)) 这个值还能得出是20
col = 3
Case Val(Split(bj(1), "-")) To Val(Split(bj(1), "-")(1))  这个就开始错误.我导到excel 得到的结果是数值型的,用在这就没办法使用