[已解决]将12个月的工资表自动生成汇总表

75397492

每年都要将12个月的工资，汇总成一个表，很麻烦，因为每个月出勤的人都不一样，附件工资表只列举了十几人，实际要有几百人，如何快速的生成汇总数据，请各位高手指教，谢谢！感激不尽！
问题补充:因为人数少，我的汇总表里的姓名一列可以提前统计出名字，而且不重复，如果没我这一列姓名怎么办？就是说汇总表里面姓名一列自动生成，切不重复。

最佳答案

月排行榜 / 总排行榜

dsmch

2015-4-1 15:45

合计自己手动添加吧

1. Sub Macro1()
   
2. Dim arr, brr, crr, d, d2, i&, j%, zf$$, k%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary") '姓名
   
5. Sheets("汇总").Activate
   
6. [a3:b65536] = ""
   
7. arr = Range("a2").CurrentRegion
   
8. For k = 2 To Sheets.Count
   
9.     crr = Sheets(k).Range("a1").CurrentRegion
   
10.     For i = 3 To UBound(crr) - 1
    
11.         d2(crr(i, 2)) = ""
    
12.         For j = 3 To UBound(crr, 2)
    
13.             zf = crr(i, 2) & "," & crr(1, 1) & "," & crr(2, j)
    
14.             d(zf) = crr(i, j)
    
15.         Next
    
16.     Next
    
17. Next
    
18. ReDim brr(1 To d2.Count, 1 To UBound(arr, 2))
    
19. a = d2.keys
    
20. For i = 1 To d2.Count
    
21.     brr(i, 1) = i
    
22.     brr(i, 2) = a(i - 1)
    
23.     For j = 3 To UBound(arr, 2)
    
24.         If arr(1, j) = "" Then arr(1, j) = arr(1, j - 1)
    
25.         zf = brr(i, 2) & "," & arr(1, j) & "," & arr(2, j)
    
26.         brr(i, j) = d(zf)
    
27.     Next
    
28. Next
    
29. Range("a3").Resize(UBound(brr), UBound(brr, 2)) = brr
    
30. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, crr, d, i&, j%, zf$, k%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Sheets("汇总").Activate
   
5. arr = Range("a2").CurrentRegion
   
6. ReDim brr(1 To UBound(arr) - 2, 1 To UBound(arr, 2) - 2)
   
7. For k = 2 To Sheets.Count
   
8.     crr = Sheets(k).Range("a1").CurrentRegion
   
9.     For i = 3 To UBound(crr)
   
10.         For j = 3 To UBound(crr, 2)
    
11.             zf = crr(i, 2) & "," & crr(1, 1) & "," & crr(2, j)
    
12.             d(zf) = crr(i, j)
    
13.         Next
    
14.     Next
    
15. Next
    
16. For i = 3 To UBound(arr)
    
17.     For j = 3 To UBound(arr, 2)
    
18.         If arr(1, j) = "" Then arr(1, j) = arr(1, j - 1)
    
19.         zf = arr(i, 2) & "," & arr(1, j) & "," & arr(2, j)
    
20.         brr(i - 2, j - 2) = d(zf)
    
21.     Next
    
22. Next
    
23. Range("c3").Resize(UBound(brr), UBound(brr, 2)) = brr
    
24. End Sub

复制代码

dsmch

………………

baksy

附件

75397492

dsmch 发表于 2015-4-1 05:55
………………

因为人数少，我的汇总表里的姓名一列可以提前统计出名字，而且不重复，如果没我这一列姓名怎么办？

75397492

dsmch 发表于 2015-4-1 05:53

因为人数少，我的汇总表里的姓名一列可以提前统计出名字，而且不重复，如果没我这一列姓名怎么办？

dsmch

合计自己手动添加吧

1. Sub Macro1()
   
2. Dim arr, brr, crr, d, d2, i&, j%, zf$$, k%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary") '姓名
   
5. Sheets("汇总").Activate
   
6. [a3:b65536] = ""
   
7. arr = Range("a2").CurrentRegion
   
8. For k = 2 To Sheets.Count
   
9.     crr = Sheets(k).Range("a1").CurrentRegion
   
10.     For i = 3 To UBound(crr) - 1
    
11.         d2(crr(i, 2)) = ""
    
12.         For j = 3 To UBound(crr, 2)
    
13.             zf = crr(i, 2) & "," & crr(1, 1) & "," & crr(2, j)
    
14.             d(zf) = crr(i, j)
    
15.         Next
    
16.     Next
    
17. Next
    
18. ReDim brr(1 To d2.Count, 1 To UBound(arr, 2))
    
19. a = d2.keys
    
20. For i = 1 To d2.Count
    
21.     brr(i, 1) = i
    
22.     brr(i, 2) = a(i - 1)
    
23.     For j = 3 To UBound(arr, 2)
    
24.         If arr(1, j) = "" Then arr(1, j) = arr(1, j - 1)
    
25.         zf = brr(i, 2) & "," & arr(1, j) & "," & arr(2, j)
    
26.         brr(i, j) = d(zf)
    
27.     Next
    
28. Next
    
29. Range("a3").Resize(UBound(brr), UBound(brr, 2)) = brr
    
30. End Sub

复制代码

75397492

75397492 发表于 2015-4-1 14:51
因为人数少，我的汇总表里的姓名一列可以提前统计出名字，而且不重复，如果没我这一列姓名怎么办？

谢谢！非常感谢！