急求！！！！字典分类排序问题

rebecca160

因业务需求，需要制作一个程序将员工数据进行分类排序整理。
具体模板和要求详见附件。
烦请各位帮忙了！

rebecca160

跪求啊！！！！！！！有没大神能帮帮忙

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("data")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:c" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       If Not d.exists(arr(i, 1)) Then
    
11.         m = 1
    
12.         ReDim brr(1 To 2, 1 To m)
    
13.       Else
    
14.         brr = d(arr(i, 1))
    
15.         m = UBound(brr, 2) + 1
    
16.         ReDim Preserve brr(1 To 2, 1 To m)
    
17.       End If
    
18.       brr(1, m) = arr(i, 2)
    
19.       brr(2, m) = arr(i, 3)
    
20.       d(arr(i, 1)) = brr
    
21.     Next
    
22.   End With
    
23.   With Worksheets("程序")
    
24.     ls = .Range("g2")
    
25.     .UsedRange.Offset(4, 0).Clear
    
26.     m = 8
    
27.     n = 2
    
28.     rmax = 0
    
29.     For Each aa In d.keys
    
30.       arr = d(aa)
    
31.       ReDim brr(1 To UBound(arr, 2), 1 To UBound(arr))
    
32.       For i = 1 To UBound(arr)
    
33.         For j = 1 To UBound(arr, 2)
    
34.           brr(j, i) = arr(i, j)
    
35.         Next
    
36.       Next
    
37.       If rmax < UBound(brr) Then
    
38.         rmax = UBound(brr)
    
39.       End If
    
40.       With .Cells(m, n)
    
41.         .Value = aa
    
42.         .Resize(1, 2).Merge
    
43.         .Interior.Color = 10192433
    
44.         .NumberFormatLocal = "m月d日"
    
45.       End With
    
46.       .Cells(m + 1, n) = "员工号"
    
47.       .Cells(m + 1, n + 1) = "姓名"
    
48.       With .Cells(m + 1, n).Resize(1, 2)
    
49.         .Interior.Color = 15261367
    
50.       End With
    
51.       .Cells(m + 2, n).Resize(UBound(brr), UBound(brr, 2)) = brr
    
52.       With .Cells(m, n).Resize(UBound(brr) + 2, 2)
    
53.         .Borders.LineStyle = xlContinuous
    
54.         .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
    
55.       End With
    
56.       n = n + 3
    
57.       If n > 14 Then
    
58.         n = 2
    
59.         m = m + rmax + 4
    
60.         rmax = 0
    
61.       End If
    
62.     Next
    
63.     With .UsedRange
    
64.       .HorizontalAlignment = xlCenter
    
65.       .VerticalAlignment = xlCenter
    
66.     End With
    
67.   End With
    
68. End Sub
    

复制代码

chxw68

男儿膝下有黄金！为了这点问题没必要“跪求”吧？

rebecca160

chxw68 发表于 2018-6-14 10:20
男儿膝下有黄金！为了这点问题没必要“跪求”吧？

哈哈 然而我是女的 谢谢大神的解答！还有员工号的排序，想问下代码要怎么写？麻烦了

rebecca160

请问还有人能帮忙看下吗。。。。。

chxw68

添加一句排序代码就行了。

rebecca160

chxw68 发表于 2018-6-16 15:49
添加一句排序代码就行了。

太感谢了！！！！