项目位置不定的个月工资汇总

ykcbf1100

汇总表从第三行开始全部自动生成。

做过后才发现，里面有很多坑：
1、姓名：同一人姓名有的中间有空格，有的没有。比如：“十”表中的“刘  琛”，其它表是“刘琛”；
2、分表中标题行数不等；
3、“打卡金额”字段：列号不同，行号也有不同；
4、分表中：合计行有的有，有的没有。

ykcbf1100

汇总表标题行自动生成、纵向合计和横向合计自动生成。

1. Sub ykcbf()  '//2024.6.21
   
2.     Application.ScreenUpdating = False
   
3.     Dim arr, brr, d
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set ws = ThisWorkbook
   
6.     Set sh = ws.Sheets("汇总")
   
7.     ReDim brr(1 To 1000, 1 To 16)
   
8.     m = 1: n = 2
   
9.     brr(1, 1) = "序号": brr(1, 2) = "姓名": brr(1, 16) = "年度合计"
   
10.     On Error Resume Next
    
11.     For x = 2 To ws.Sheets.Count
    
12.         With ws.Sheets(x)
    
13.             r = .UsedRange.Rows.Count
    
14.             Set Rng = .UsedRange.Find("打卡金额")
    
15.             r1 = Rng.Row: c1 = Rng.Column
    
16.             arr = .Range("a1:l" & r)
    
17.             fn = .Name
    
18.         End With
    
19.         For i = r1 + 1 To UBound(arr)
    
20.             s = Replace(arr(i, 3), " ", "")
    
21.             If Val(arr(i, 1)) Then
    
22.                 If Not d.exists(s) Then
    
23.                     m = m + 1
    
24.                     d(s) = m
    
25.                     brr(m, 1) = m - 1
    
26.                     brr(m, 2) = s
    
27.                 End If
    
28.                 r = d(Replace(arr(i, 3), " ", ""))
    
29.                 s = fn
    
30.                 If Not d.exists(s) Then
    
31.                     n = n + 1
    
32.                     d(s) = n
    
33.                     brr(1, n) = s
    
34.                 End If
    
35.                 c = d(fn)
    
36.                 brr(r, c) = brr(r, c) + arr(i, c1)
    
37.             End If
    
38.         Next
    
39.     Next
    
40.     With sh
    
41.         bt = 3
    
42.         .UsedRange.Offset(2).Clear
    
43.         .Cells(bt, 1).Resize(m, 16) = brr
    
44.         .Cells(bt, 3).Resize(1, 13).Interior.Color = 49407
    
45.         .Cells(bt, 2).Resize(m, 1).Interior.Color = 5296274
    
46.         r = .Cells(Rows.Count, 1).End(3).Row
    
47.         .Cells(r + 1, 2) = "月份合计"
    
48.         With .Cells(bt, 1).Resize(m + 1, 16)
    
49.             .Borders.LineStyle = 1
    
50.             .HorizontalAlignment = xlCenter
    
51.             .VerticalAlignment = xlCenter
    
52.         End With
    
53.         For i = bt + 1 To r
    
54.             .Cells(i, 16) = Application.Sum(.Cells(i, 3).Resize(, 13))
    
55.         Next
    
56.         .Cells(bt, 16).Resize(m + 1).Interior.ColorIndex = 8
    
57.         For j = 3 To 16
    
58.             .Cells(r + 1, j) = Application.Sum(.Cells(bt + 1, j).Resize(m - 1))
    
59.             .Cells(r + 1, 2).Resize(, 15).Interior.ColorIndex = 15
    
60.         Next
    
61.     End With
    
62.     Set d = Nothing
    
63.     Application.ScreenUpdating = True
    
64.     MsgBox "OK！"
    
65. End Sub
    

复制代码

jjmysjg

feilanga 发表于 2024-6-20 23:27
关于find 如果表格不规范,还是得根据实际情况来写.总不能1个表1个样.喜欢满表里找表头关键字 那就去找吧.自 ...

谢谢大师，可惜再增加表，不能汇总。

jjmysjg

ykcbf1100 发表于 2024-6-21 00:24
汇总表从第三行开始全部自动生成。

做过后才发现，里面有很多坑：

谢谢大师！
1、同一人姓名有的中间有空格，是上报的数据簿规范，不用管他，就按各自的汇总；
2、分表中标题行数不等，“打卡金额”字段列号不同，行号也有不同，这个就是要求使用“FIND"的原因，
3、分表的合计，有的字间有空格，有的与其他字符混合，这个需要代码能够识别”合“&”计“

jjmysjg

ykcbf1100 发表于 2024-6-21 00:25
汇总表标题行自动生成、纵向合计和横向合计自动生成。

能修改以下，增加表也可以继续汇总吗

ykcbf1100

jjmysjg 发表于 2024-6-21 07:12
能修改以下，增加表也可以继续汇总吗

改好了。。。

ykcbf1100

数据表可以增减。

1. Sub ykcbf()  '//2024.6.21  数据表可以增减。
   
2.     Application.ScreenUpdating = False
   
3.     Dim arr, brr, d
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set ws = ThisWorkbook
   
6.     Set sh = ws.Sheets("汇总")
   
7.     ReDim brr(1 To 1000, 1 To 100)
   
8.     m = 1: n = 2
   
9.     Count = ws.Sheets.Count
   
10.     brr(1, 1) = "序号": brr(1, 2) = "姓名": brr(1, Count + 2) = "年度合计"
    
11.     On Error Resume Next
    
12.     For x = 2 To Count
    
13.         With ws.Sheets(x)
    
14.             r = .UsedRange.Rows.Count
    
15.             Set Rng = .UsedRange.Find("打卡金额")
    
16.             r1 = Rng.Row: c1 = Rng.Column
    
17.             arr = .Range("a1:l" & r)
    
18.             fn = .Name
    
19.         End With
    
20.         For i = r1 + 1 To UBound(arr)
    
21.             s = Replace(arr(i, 3), " ", "")
    
22.             If Val(arr(i, 1)) Then
    
23.                 If Not d.exists(s) Then
    
24.                     m = m + 1
    
25.                     d(s) = m
    
26.                     brr(m, 1) = m - 1
    
27.                     brr(m, 2) = s
    
28.                 End If
    
29.                 r = d(Replace(arr(i, 3), " ", ""))
    
30.                 s = fn
    
31.                 If Not d.exists(s) Then
    
32.                     n = n + 1
    
33.                     d(s) = n
    
34.                     brr(1, n) = s
    
35.                 End If
    
36.                 c = d(fn)
    
37.                 brr(r, c) = brr(r, c) + arr(i, c1)
    
38.             End If
    
39.         Next
    
40.     Next
    
41.     With sh
    
42.         bt = 3
    
43.         .UsedRange.Offset(2).Clear
    
44.         .Cells(bt, 1).Resize(m, Count + 2) = brr
    
45.         .Cells(bt, 3).Resize(1, Count - 1).Interior.Color = 49407
    
46.         .Cells(bt, 2).Resize(m, 1).Interior.Color = 5296274
    
47.         r = .Cells(Rows.Count, 1).End(3).Row
    
48.         .Cells(r + 1, 2) = "月份合计"
    
49.         With .Cells(bt, 1).Resize(m + 1, Count + 2)
    
50.             .Borders.LineStyle = 1
    
51.             .HorizontalAlignment = xlCenter
    
52.             .VerticalAlignment = xlCenter
    
53.         End With
    
54.         For i = bt + 1 To r
    
55.             .Cells(i, Count + 2) = Application.Sum(.Cells(i, 3).Resize(, Count - 1))
    
56.         Next
    
57.         .Cells(bt, Count + 2).Resize(m + 1).Interior.ColorIndex = 8
    
58.         For j = 3 To Count + 2
    
59.             .Cells(r + 1, j) = Application.Sum(.Cells(bt + 1, j).Resize(m - 1))
    
60.             .Cells(r + 1, 2).Resize(, Count).Interior.ColorIndex = 15
    
61.         Next
    
62.     End With
    
63.     Set d = Nothing
    
64.     Application.ScreenUpdating = True
    
65.     MsgBox "OK！"
    
66. End Sub
    

复制代码

feilanga

新增表格也可以加入统计了。不过，底部合计写着麻烦，没写。代码有些粗糙，仅做参考把。

jjmysjg

feilanga 发表于 2024-6-21 08:48
新增表格也可以加入统计了。不过，底部合计写着麻烦，没写。代码有些粗糙，仅做参考把。

谢谢大师！

jjmysjg

ykcbf1100 发表于 2024-6-21 07:33
数据表可以增减。

如果第2个以后的表中没有“记工姓名”或“打卡金额”字段，数据依旧汇总进去了，麻烦大师看看。
能否做到：如果分没有这两个字段，汇总表中这个表列的数据为空。