12个月的工资表，如何汇总到一张表上

tjxy333

佛山小老鼠 发表于 2017-11-10 20:38
楼主：帮你写半个小时的代码，你没听到你反馈问题解决了没有，建议你以后提问，别人回复你了，记得说声谢谢 ...

佛山小老鼠老师的话有道理！点赞！

jjmysjg

留下记号，谢谢二位大师

jjmysjg

chxw68 发表于 2017-11-10 20:07
详见附件。

一直在收集这样实用的汇总模板，能否在原贴的基础上改进一下，
既汇总表字段由工作表名自动提取，增列列、行末尾合计，表数不定，
详细见附表。
不知能否实现。
看见两位老师的回复，求助

jjmysjg

佛山小老鼠 发表于 2017-11-10 00:12

24楼的帖子正在审核，麻烦版主看看能否实现。

jjmysjg

数据为文件夹内独立的工作簿，能否也能实现这个效果，

jjmysjg

怎么还没审核通过？？

chxw68

1. Sub test2()
   
2.   Dim r%, i%
   
3.   Dim arr, brr, bt()
   
4.   Dim ws As Worksheet
   
5.   Dim d As Object
   
6.   Set d = CreateObject("scripting.dictionary")
   
7.   
   
8.   n = 0
   
9.   For Each ws In Worksheets
   
10.     If ws.Name <> "汇总" Then
    
11.       n = n + 1
    
12.       ReDim Preserve bt(1 To n)
    
13.       bt(n) = ws.Name
    
14.     End If
    
15.   Next
    
16.   
    
17.   For k = 1 To UBound(bt)
    
18.     With Worksheets(bt(k))
    
19.       r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
20.       c = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
21.       arr = .Range("a1").Resize(r, c)
    
22.       For j = 1 To UBound(arr, 2)
    
23.         If arr(1, j) = "应发合计" Then
    
24.           Exit For
    
25.         End If
    
26.       Next
    
27.       If j <= UBound(arr, 2) Then
    
28.         For i = 2 To UBound(arr)
    
29.           If Not d.exists(arr(i, 2)) Then
    
30.             ReDim brr(1 To UBound(bt) + 2)
    
31.             brr(1) = arr(i, 2)
    
32.           Else
    
33.             brr = d(arr(i, 2))
    
34.           End If
    
35.           brr(k + 1) = brr(k + 1) + arr(i, j)
    
36.           brr(UBound(bt) + 2) = brr(UBound(bt) + 2) + arr(i, j)
    
37.           d(arr(i, 2)) = brr
    
38.         Next
    
39.       End If
    
40.     End With
    
41.   Next
    
42.   brr = Application.Transpose(Application.Transpose(d.items))
    
43.   ReDim crr(1 To UBound(brr, 2))
    
44.   crr(1) = "合计"
    
45.   For j = 2 To UBound(brr, 2)
    
46.     crr(j) = Application.Sum(Application.Index(brr, 0, j))
    
47.   Next
    
48.    
    
49.   
    
50.   With Worksheets("汇总")
    
51.     .Cells.Clear
    
52.     .Range("a1") = "姓名"
    
53.     .Range("b1").Resize(1, UBound(bt)) = bt
    
54.     .Cells(1, UBound(bt) + 2) = "合计"
    
55.     .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
56.     r = UBound(brr) + 2
    
57.     .Cells(r, 1).Resize(1, UBound(crr)) = crr
    
58.     .Range("a1").Resize(r, UBound(bt) + 2).Borders.LineStyle = xlContinuous
    
59.     With .Range("a:a,1:1")
    
60.       .HorizontalAlignment = xlCenter
    
61.       .VerticalAlignment = xlCenter
    
62.     End With
    
63.    
    
64.   End With
    
65.   
    
66. End Sub
    
67. 
    
68. 
    

复制代码

chxw68

详见附件。

jjmysjg

chxw68 发表于 2017-11-13 09:05
详见附件。

谢谢褚老师，就是这样的效果

kiss8852

LMY123 发表于 2017-11-10 10:59
字典同薄多表汇总，ACCESS

虽然不太明白，那也谢谢您的解答