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

blackttea1

学习啦，谢谢

chibing7464

chxw68 发表于 2019-5-31 19:20
详见附件。

老师， 如果有人员重名怎么办？ 能不能把姓名 和身份证都汇总，并且把重名的人根据身份证分开汇总呢？
期待老师指点。本人小白。

syzengpeng

mizl167 发表于 2017-11-10 16:00
我觉得这样好看些

您这个工资表我觉得相当清晰，能发一个给我参考下吗？

syzengpeng

16楼的我觉得最明确了，非常清晰明了，谁有这种版本吗

九块二毛三

mizl167 发表于 2017-11-10 16:00
我觉得这样好看些

你好，请问这个表格能否分享一份，不胜感激

jjmysjg

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

与原来帖子一样，只汇总“应付工资”，但字段标题是4行且有合并单元格，怎么查找“应付工资”字段？
谢谢！

ykcbf1100

纯练手，向前辈学习。

ykcbf1100

练手而已。

1. Sub 多表汇总()   '//2024.2.13
   
2.     Application.ScreenUpdating = False
   
3.     Dim arr, brr(1 To 10000, 1 To 13), d, i, m, c, col
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set sh = Sheets("汇总")
   
6.     c = 1
   
7.     For Each sht In Sheets
   
8.         If sht.Name <> sh.Name Then
   
9.             c = c + 1
   
10.             With sht
    
11.                 arr = .UsedRange
    
12.                 col = Application.Match("应发合计", .Rows(1), 0)
    
13.                 For i = 2 To UBound(arr)
    
14.                     s = arr(i, 2)
    
15.                     If Not d.exists(s) Then
    
16.                         m = m + 1
    
17.                         d(s) = m
    
18.                         brr(m, 1) = s       '//姓名排重
    
19.                     End If
    
20.                     brr(d(s), c) = brr(d(s), c) + arr(i, col)
    
21.                 Next
    
22.             End With
    
23.         End If
    
24.     Next
    
25.     With sh
    
26.         .UsedRange.Offset(1).Clear
    
27.         With .[A1].Resize(m, 13)
    
28.             .Offset(1).Value = brr
    
29.             .Borders.LineStyle = 1
    
30.             .HorizontalAlignment = xlCenter
    
31.             .VerticalAlignment = xlCenter
    
32.         End With
    
33.         ActiveWindow.DisplayZeros = False
    
34.     End With
    
35.     Application.ScreenUpdating = True
    
36.     MsgBox "OK！"
    
37. End Sub
    
38. 
    

复制代码

ykcbf1100

jjmysjg 发表于 2024-2-13 11:51
与原来帖子一样，只汇总“应付工资”，但字段标题是4行且有合并单元格，怎么查找“应付工资”字段？
谢 ...

不能完全套用原代码的。

附件供参考，汇总表数据全部自动生成。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.2.13
   
2.     Application.ScreenUpdating = False
   
3.     Dim arr, brr(1 To 10000, 1 To 20), d, i, m, c, col
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set sh = Sheets("汇总")
   
6.     c = 1
   
7.     m = 1: brr(1, 1) = "姓名"
   
8.     For Each sht In Sheets
   
9.         If sht.Name <> sh.Name Then
   
10.             c = c + 1
    
11.             brr(1, c) = CStr(sht.Name)
    
12.             With sht
    
13.                 arr = .UsedRange
    
14.                 col = Application.Match("应发合计", .Rows(3), 0)
    
15.                 For i = 5 To UBound(arr)
    
16.                     s = arr(i, 2)
    
17.                     If Not d.exists(s) Then
    
18.                         m = m + 1
    
19.                         d(s) = m
    
20.                         brr(m, 1) = s       '//姓名排重
    
21.                     End If
    
22.                     brr(d(s), c) = brr(d(s), c) + arr(i, col)
    
23.                 Next
    
24.             End With
    
25.         End If
    
26.     Next
    
27.     brr(1, c + 1) = "合计"
    
28.     With sh
    
29.         .UsedRange.Clear
    
30.         With .[A1].Resize(m, c + 1)
    
31.             .Value = brr
    
32.             .Borders.LineStyle = 1
    
33.             .HorizontalAlignment = xlCenter
    
34.             .VerticalAlignment = xlCenter
    
35.         End With
    
36.         r = .Cells(Rows.Count, 1).End(3).Row
    
37.         For i = 2 To r
    
38.             .Cells(i, c + 1).FormulaR1C1 = "=SUM(RC[-" & c - 1 & "]:RC[-1])"
    
39.         Next
    
40.         With .Range(.Cells(2, c + 1), .Cells(r, c + 1))
    
41.             .HorizontalAlignment = xlRight
    
42.             .VerticalAlignment = xlCenter
    
43.         End With
    
44.         ActiveWindow.DisplayZeros = False
    
45.     End With
    
46.     Application.ScreenUpdating = True
    
47.     MsgBox "OK！"
    
48. End Sub
    

复制代码