请帮忙自动生成在职与离职表，多谢！

TSGRH · 发表于 2024-8-21 10:51

请帮忙，在人员表中设置一个按钮，根据查询的月份自动生成相应的在职表，离职表，在职人员汇总和各月人数统计。各月人数统计表则从最早入职月份到查询月份。多谢！

Peny2020 · 发表于 2024-8-21 11:15

你的查询的月份是指今年1-12月？还是按什么数据来做？

TSGRH · 发表于 2024-8-21 11:21

你好，查询的月份是最早入职日期的月份到当月，多谢！

TSGRH · 发表于 2024-8-21 11:29

各月人数统计表可以按年查询就行了，多谢！

ykcbf1100 · 发表于 2024-8-21 11:57

生成在职、离职表

ykcbf1100 · 发表于 2024-8-21 11:58

参与一下。。。

Sub ykcbf() '//2024.8.21
arr = Sheets("人员表").UsedRange
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 4 To UBound(arr)
Select Case arr(i, 1)
Case Is = "在职"
m = m + 1
For j = 1 To UBound(arr, 2)
brr(m, j) = arr(i, j)
Next
Case Is = "离职"
n = n + 1
For j = 1 To UBound(arr, 2)
crr(n, j) = arr(i, j)
Next
End Select
Next
With Sheets("在职表")
.UsedRange.Offset(3).ClearContents
.[a4].Resize(m, UBound(arr, 2)) = brr
End With
With Sheets("离职表")
.UsedRange.Offset(3).ClearContents
.[a4].Resize(n, UBound(arr, 2)) = crr
End With
MsgBox "OK！"
End Sub

复制代码

ykcbf1100 · 发表于 2024-8-21 12:19

增加一个在职人员汇总

各月人数统计表，没搞清楚状况，就先不统计了

ykcbf1100 · 发表于 2024-8-21 12:20

问题不难，就是繁。

Sub ykcbf() '//2024.8.21
Set d = CreateObject("Scripting.Dictionary")
arr = Sheets("人员表").UsedRange
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2))
ReDim zrr(1 To 6)
For i = 4 To UBound(arr)
If arr(i, 1) <> Empty Then
Select Case arr(i, 1)
Case Is = "在职"
m = m + 1
For j = 1 To UBound(arr, 2)
brr(m, j) = arr(i, j)
Next
Case Is = "离职"
n = n + 1
For j = 1 To UBound(arr, 2)
crr(n, j) = arr(i, j)
Next
End Select
s = arr(i, 5)
d(s) = d(s) + 1
s = arr(i, 6)
d(s) = d(s) + 1
zrr(1) = zrr(1) + IIf(arr(i, 13) <= 30, 1, 0)
zrr(2) = zrr(2) + IIf((arr(i, 13) > 30 And arr(i, 13) <= 40), 1, 0)
zrr(3) = zrr(3) + IIf((arr(i, 13) > 40 And arr(i, 13) <= 50), 1, 0)
zrr(4) = zrr(4) + IIf((arr(i, 13) > 50 And arr(i, 13) <= 60), 1, 0)
zrr(5) = zrr(5) + IIf((arr(i, 13) > 60 And arr(i, 13) <= 70), 1, 0)
zrr(6) = zrr(6) + IIf(arr(i, 13) > 70, 1, 0)
End If
Next
With Sheets("在职表")
.UsedRange.Offset(3).ClearContents
.[a4].Resize(m, UBound(arr, 2)) = brr
End With
With Sheets("离职表")
.UsedRange.Offset(3).ClearContents
.[a4].Resize(n, UBound(arr, 2)) = crr
End With
With Sheets("在职人员汇总")
Sum = 0
For i = 3 To 4
s = .Cells(i, 1).Value
.Cells(i, 2) = d(s)
Sum = Sum + .Cells(i, 2).Value
Next
.Cells(5, 2) = Sum
.Range("C:C,l:L").NumberFormatLocal = "0.00%"
For i = 3 To 4
.Cells(i, 3) = .Cells(i, 2).Value / Sum
Next
Sum = 0: m = 0
For i = 11 To 16
m = m + 1
.Cells(i, 2) = zrr(m)
Sum = Sum + .Cells(i, 2).Value
Next
.Cells(17, 2) = Sum
.Columns(3).NumberFormatLocal = "0.00%"
For i = 11 To 16
.Cells(i, 3) = .Cells(i, 2).Value / Sum
Next
Sum = 0
For i = 3 To 30
s = .Cells(i, "j").Value
.Cells(i, "k") = d(s)
Sum = Sum + .Cells(i, "k").Value
Next
.Cells(31, "k") = Sum
.Columns(3).NumberFormatLocal = "0.00%"
For i = 3 To 30
.Cells(i, 12) = .Cells(i, 11).Value / Sum
Next
End With
MsgBox "OK！"
End Sub

复制代码

TSGRH · 发表于 2024-8-21 14:47

多谢老师的帮忙，发现有几点麻烦帮更改下，多谢！1）查询后生成的在职表和离职表数据不对。在职表是指截止到查询日期与入职日期相同月份的数据，比如入职日期中有：2024年7月和8月，我查询输入7月的，8月入职的就不显示了。离职表是查询月份的离职人员，比如我查询8月离职人员，7月离职就不用显示了。2）生成在职表和离职表中身份证号列格式为文本，字体和字号与人员表一样，最好有表格线。3）在职人员汇总是对查询后的在职表进行汇总，增设省内省外（P列），合同类型（X列），购社保（AF列）

TSGRH · 发表于 2024-8-22 10:13

期待着大家的帮忙，多谢！

		自动登录	找回密码
密码			免费注册

[求助] 请帮忙自动生成在职与离职表，多谢！

评分