如何将花名册人员以合同主体、部门对员工的年龄、学历等信息进行分类汇总？

3190496160

小妮酱子

3190496160 发表于 2024-7-12 12:47

太感谢您了，我上传了，麻烦您帮忙看下啦

小妮酱子

松永 发表于 2024-7-12 09:40
没上传附件？

谢谢您的回复，附件我上传啦，麻烦您帮忙看下，十分感谢

小妮酱子

37廿一 发表于 2024-7-11 20:08
建议用模拟数据制作附件上传

谢谢您的回复。我上传到附件啦，麻烦您帮忙看下，十分感谢

laomu2010

第23行宋宇，那个年龄是个文本数字，检查了好久

他她店铺

laomu2010 发表于 2024-7-12 16:31
第23行宋宇，那个年龄是个文本数字，检查了好久

劳务外包没有考虑进去

3190496160

Sub 无主体分类统计()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
Set d4 = CreateObject("scripting.dictionary")
With ActiveSheet
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "数据源为空！": End
    ar = .Range("a1:g" & r)
    .Range("L4:O9,L12:O17,L19:O24,L27:O32") = Empty
    br = .Range("k1:o32")
    For i = 4 To 9
        d1(br(i, 1)) = i
    Next i
    For i = 12 To 17
        d2(br(i, 1)) = i
    Next i
    For i = 19 To 24
        d3(br(i, 1)) = i
    Next i
    For i = 27 To 32
        d4(br(i, 1)) = i
    Next i
    For i = 2 To UBound(ar)
        If ar(i, 2) <> "" Then
            If ar(i, 6) <> "" Then
                xh = d1(ar(i, 2))
                If xh <> "" Then
                    If ar(i, 6) <= 30 Then
                        br(xh, 2) = br(xh, 2) + 1
                    End If
                    If ar(i, 6) >= 31 And ar(i, 6) <= 40 Then
                        br(xh, 3) = br(xh, 3) + 1
                    End If
                    If ar(i, 6) >= 41 And ar(i, 6) <= 50 Then
                        br(xh, 4) = br(xh, 4) + 1
                    End If
                    If ar(i, 6) >= 51 Then
                        br(xh, 5) = br(xh, 5) + 1
                    End If
                End If
            End If
            If ar(i, 5) <> "" Then
                xh = d2(ar(i, 2))
                If xh <> "" Then
                    If ar(i, 5) = "博士" Then
                        br(xh, 2) = br(xh, 2) + 1
                    ElseIf ar(i, 5) = "硕士" Then
                        br(xh, 3) = br(xh, 3) + 1
                    ElseIf ar(i, 5) = "本科" Then
                        br(xh, 4) = br(xh, 4) + 1
                    Else
                        br(xh, 5) = br(xh, 5) + 1
                    End If
                End If
            End If
            If ar(i, 4) <> "" Then
                xh = d3(ar(i, 2))
                If xh <> "" Then
                    If ar(i, 4) = "全职" Then
                        br(xh, 2) = br(xh, 2) + 1
                    ElseIf ar(i, 4) = "实习" Or InStr(ar(i, 4), "外包") > 0 Then
                        br(xh, 3) = br(xh, 3) + 1
                    ElseIf ar(i, 4) = "临时聘用" Then
                        br(xh, 4) = br(xh, 4) + 1
                    End If
                End If
            End If
            If ar(i, 3) <> "" Then
                xh = d4(ar(i, 2))
                If xh <> "" Then
                    If ar(i, 3) = "技术类" Then
                        br(xh, 2) = br(xh, 2) + 1
                    Else
                        br(xh, 4) = br(xh, 4) + 1
                    End If
                End If
            End If
        End If
    Next i
    .Range("k1:o32") = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

Sub 选择主体分类统计()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
Set d4 = CreateObject("scripting.dictionary")
With ActiveSheet
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "数据源为空！": End
    zd = .[q1]
    If zd = "" Then MsgBox "请输入要统计的公司名称！": End
    ar = .Range("a1:g" & r)
    .Range("r4:u9,r12:u17,r19:u24,r27:u32") = Empty
    br = .Range("q1:u32")
    For i = 4 To 9
        d1(br(i, 1)) = i
    Next i
    For i = 12 To 17
        d2(br(i, 1)) = i
    Next i
    For i = 19 To 24
        d3(br(i, 1)) = i
    Next i
    For i = 27 To 32
        d4(br(i, 1)) = i
    Next i
    For i = 2 To UBound(ar)
        If ar(i, 7) = zd Then
            m = m + 1
            If ar(i, 2) <> "" Then
                If ar(i, 6) <> "" Then
                    xh = d1(ar(i, 2))
                    If xh <> "" Then
                        If ar(i, 6) <= 30 Then
                            br(xh, 2) = br(xh, 2) + 1
                        End If
                        If ar(i, 6) >= 31 And ar(i, 6) <= 40 Then
                            br(xh, 3) = br(xh, 3) + 1
                        End If
                        If ar(i, 6) >= 41 And ar(i, 6) <= 50 Then
                            br(xh, 4) = br(xh, 4) + 1
                        End If
                        If ar(i, 6) >= 51 Then
                            br(xh, 5) = br(xh, 5) + 1
                        End If
                    End If
                End If
                If ar(i, 5) <> "" Then
                    xh = d2(ar(i, 2))
                    If xh <> "" Then
                        If ar(i, 5) = "博士" Then
                            br(xh, 2) = br(xh, 2) + 1
                        ElseIf ar(i, 5) = "硕士" Then
                            br(xh, 3) = br(xh, 3) + 1
                        ElseIf ar(i, 5) = "本科" Then
                            br(xh, 4) = br(xh, 4) + 1
                        Else
                            br(xh, 5) = br(xh, 5) + 1
                        End If
                    End If
                End If
                If ar(i, 4) <> "" Then
                    xh = d3(ar(i, 2))
                    If xh <> "" Then
                        If ar(i, 4) = "全职" Then
                            br(xh, 2) = br(xh, 2) + 1
                        ElseIf ar(i, 4) = "实习" Or InStr(ar(i, 4), "外包") > 0 Then
                            br(xh, 3) = br(xh, 3) + 1
                        ElseIf ar(i, 4) = "临时聘用" Then
                            br(xh, 4) = br(xh, 4) + 1
                        End If
                    End If
                End If
                If ar(i, 3) <> "" Then
                    xh = d4(ar(i, 2))
                    If xh <> "" Then
                        If ar(i, 3) = "技术类" Then
                            br(xh, 2) = br(xh, 2) + 1
                        Else
                            br(xh, 4) = br(xh, 4) + 1
                        End If
                    End If
                End If
            End If
        End If
    Next i
    If m = "" Then MsgBox "数据源中没有所选公司的数据！": End
    .Range("q1:u32") = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

附件.rar (25 KB, 下载次数: 13)

2024-7-13 10:47 上传

点击文件名下载附件

3190496160

临时聘用人员，在数据源中是如何体现，不明确，因为，目前的数据源中没有，代码中用   临时聘用   字段来判断，可以根据实际情况修改