如何按部门展示每个职级的人员情况

huolaosan

如何将人员职级明细表按部门展示每个职级的人员情况，
具体情况：

huolaosan

请哪位大神帮忙看看如何实现，谢谢

小凡、、、

新版本可以考虑使用函数解决

liulang0808

附件不可用的，论坛案例不少的，使用字典嵌套处理下

飞天篮球猪

小凡、、、

新版本一个函数基本就快搞定了

baofa2

1. Option Explicit
   
2. 
   
3. Sub test2()
   
4.   
   
5.   Dim data, result() As String, dict As Object
   
6.   Dim i As Long, strKey As String
   
7.   Dim posRow As Long, posCol As Long, rowSize As Long, colSize As Long
   
8.   
   
9.   Set dict = CreateObject("Scripting.Dictionary")
   
10.   dict.CompareMode = 1 'TextCompare
    
11.   data = Range("A1").CurrentRegion
    
12.   ReDim result(1 To UBound(data), 1 To 99)
    
13.   
    
14.   rowSize = 1
    
15.   colSize = 1
    
16.   result(rowSize, colSize) = data(rowSize, 3)
    
17.   
    
18.   For i = 2 To UBound(data)
    
19.    
    
20.     strKey = data(i, 3)
    
21.     If Not dict.Exists(strKey) Then
    
22.       rowSize = rowSize + 1
    
23.       result(rowSize, 1) = strKey
    
24.       dict.Add strKey, rowSize
    
25.     End If
    
26.     posRow = dict(strKey)
    
27.    
    
28.     strKey = data(i, 2)
    
29.     If Not dict.Exists(strKey) Then
    
30.       colSize = colSize + 1
    
31.       result(1, colSize) = strKey
    
32.       dict.Add strKey, colSize
    
33.     End If
    
34.     posCol = dict(strKey)
    
35.    
    
36.     If Len(result(posRow, posCol)) Then
    
37.       result(posRow, posCol) = result(posRow, posCol) & "；" & data(i, 1)
    
38.     Else
    
39.       result(posRow, posCol) = data(i, 1)
    
40.     End If
    
41.   Next
    
42.   
    
43.   With Range("F1")
    
44.     .CurrentRegion.Clear
    
45.     With .Resize(rowSize, colSize)
    
46.       .Borders.LineStyle = xlContinuous
    
47.       .HorizontalAlignment = xlCenter
    
48.       .Rows(1).Font.Bold = True
    
49.       .Value = result
    
50.     End With
    
51.   End With
    
52.   
    
53.   Set dict = Nothing
    
54.   Beep
    
55. End Sub

复制代码

全党

1. Sub shishi()
   
2. Set d = CreateObject("scripting.dictionary")
   
3. arr = Range("c4").CurrentRegion
   
4. brr = Range("i4").CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.   If Not d.exists(arr(i, 3) & "|" & arr(i, 2)) Then
   
7.      d(arr(i, 3) & "|" & arr(i, 2)) = arr(i, 1)
   
8.   Else
   
9.      d(arr(i, 3) & "|" & arr(i, 2)) = d(arr(i, 3) & "|" & arr(i, 2)) & "；" & arr(i, 1)
   
10.   End If
    
11. Next
    
12. For i = 2 To UBound(brr)
    
13.   For j = 2 To UBound(brr, 2)
    
14.   brr(i, j) = d(brr(i, 1) & "|" & brr(1, j))
    
15.   Next
    
16. Next
    
17. Range("i4").CurrentRegion = brr
    
18. 
    
19. End Sub

复制代码

好在数据少，按照你的格式敲了一遍。再提问记得上附件。

ykcbf1100

一个空附件，算了。

huolaosan

已补上传附件，感谢前面的大神