请老师模拟一下字典法得到上面的结果，谢谢！

Qs18

试试..........

hcy1185

衷心感谢各位老师的热心帮助！我下载好好学习一下！

titi012

参与一下。。。。。
这个用了类模块

1. Sub Test()
   
2.     Dim Arr, x&, Per As Person, Comp As New Company
   
3.     Arr = Range("b2:d" & Cells(Rows.Count, 4).End(xlUp).Row)
   
4.     For x = 1 To UBound(Arr)
   
5.         Set Per = New Person
   
6.         Per.Level = Arr(x, 1)
   
7.         Per.Name = Arr(x, 2)
   
8.         Per.Achieve = Arr(x, 3)
   
9.         Comp.Add Per
   
10.         Set Per = Nothing
    
11.     Next x
    
12.     Range("H2").Resize(Comp.PCount + 1, 3) = Comp.Data
    
13. End Sub
    

复制代码

hcy1185

半百 发表于 2024-7-29 11:52

请教一下！姓名前为什么加岗位？谢谢！

半百

hcy1185 发表于 2024-7-29 16:33
请教一下！姓名前为什么加岗位？谢谢！

姓名前加岗位？没有啊。你说的是指a(0)=a(0) & "," & ar(i,3)，这句吗？a(0)就是姓名，& ar(i,3)就是将再次出现的岗位对应的姓名合并到已有的姓名后边。

hcy1185

杨建营 发表于 2024-7-29 11:30
请楼主参考

老师早上好！再请教一下，如何用字典法计算出岗位的数量 以及 每个岗位的人数，每个岗位的人数放到单元格区域，谢谢！

feilanga

杨建营

hcy1185 发表于 2024-7-31 08:15
老师早上好！再请教一下，如何用字典法计算出岗位的数量 以及 每个岗位的人数，每个岗位的人数放到单元格 ...

请楼主参考。

hcy1185

杨建营 发表于 2024-7-31 11:49
请楼主参考。

衷心感谢！

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, i&, dic As Object
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = [A1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        If Not dic.exists(ar(i, 2)) Then
            dic(ar(i, 2)) = Array(ar(i, 2), ar(i, 3), ar(i, 4), 1)
        Else
            br = dic(ar(i, 2))
            br(1) = br(1) & "," & ar(i, 3)
            br(2) = br(2) + ar(i, 4)
            br(3) = br(3) + 1
            dic(ar(i, 2)) = br
        End If
    Next i
   
    [M2].CurrentRegion.Offset(1).Clear
    [M3].Resize(dic.Count, 4) = Application.Rept(dic.items, 1)
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub