如何将名单列表转化为可视的名单

excelpianpian

各位大大们，因为要做很多的名单供发东西使用，有人员的明细，需要将人员明细的表格变成一列10行人的可视表格，附件中“数据源”就是人员的明细，我想根据数据源变成第二个表的名单，谢谢拉！
初来乍到，如果哪位大大能帮忙解决，100元话费送上。

sunya_0529

这个用VBA来统计很方便，效果如下图所示——


代码如下——

1. Option Explicit
   
2. 
   
3. Sub 整理名单()
   
4. Dim rngDB As Range, arr(9999, 10), c As Range, i%, j%, k%
   
5. 'Set rngDB = Application.InputBox("请选择数据源所在单元格区域：", "数据选择", Type:=8)
   
6. 'If rngDB Is Nothing Then Exit Sub
   
7. Set rngDB = Sheets("数据源").UsedRange
   
8. With rngDB
   
9.   .Sort Key1:=.Cells(1, 3), Order1:=xlAscending, Key2:=.Cells(1, 4), Order2:=xlAscending '对数据区域按部门和子部门排序
   
10.   i = 2
    
11.   arr(0, 0) = "劳保名单（人数：" & Application.CountA(.Columns(1)) & "人）"
    
12.   Do While Len(.Cells(i, 3)) > 0 '在部门列循环
    
13.     If .Cells(i, 3) <> .Cells(i - 1, 3) Then '碰到部门第一条数据，写入数组
    
14.       j = j + 1 '数组记录行数累进
    
15.       arr(j, 0) = .Cells(i, 3) & " " & .Cells(i, 4) '写入部门名
    
16.       arr(j, 1) = .Cells(i, 1) '写入人名
    
17.       k = 1 '数组中同一行数据列数计数器初始为1
    
18.     Else '同部门数据，每十列为一组写入数组
    
19.       If .Cells(i, 4) <> .Cells(i - 1, 4) Then '碰到同部门不同子部门的第一条数据，修改计数器
    
20.         j = j + 1 '数组行数+1
    
21.         k = 0 '数组内列数计数器归0
    
22.         arr(j, 0) = .Cells(i, 3) & " " & .Cells(i, 4) '写入部门名
    
23.       End If
    
24.       k = k + 1 '数组内列计数器累进
    
25.       If k > 10 Then '当K累进超过10时，数组记录行数+1，同时列数计数器初始为1
    
26.         j = j + 1
    
27.         k = 1
    
28.       End If
    
29.       arr(j, k) = .Cells(i, 1) '根据列数K的值向数组内写入人名
    
30.     End If
    
31.     i = i + 1 '数据记录行数计数器累进
    
32.   Loop
    
33. End With
    
34. [G:Q].ClearContents '清空结果显示区域
    
35. [G1].Resize(UBound(arr), 11) = arr '输出统计结果
    
36. End Sub

复制代码

附件如下——

excelpianpian

sunya_0529 发表于 2016-10-18 14:18
这个用VBA来统计很方便，效果如下图所示——

这个下载以后怎么用呢？ 如果以后我需要变动其它的数据，就是前面的数据源

sunya_0529

excelpianpian 发表于 2016-10-18 16:59
这个下载以后怎么用呢？ 如果以后我需要变动其它的数据，就是前面的数据源

如果你的数据源就这么几列的话，就在原来这里更新就好了，如果数据源不是现在举例子的这个样子，需要把完成的数据贴上来看看。