1-12月工资表汇总

jjmysjg

chxw68 发表于 2022-5-30 18:51
表头自动生成，要汇总的项目可以在任意一列，位置也不要求一致。

储老师你好：
如果各表不含“月”，没规律，能达到这个效果吗

明天会更好zj

这种不规范的表和不规范的结果，不推荐。

明天会更好zj

建议这个样子规范做表，以后统计核实就简单得多。

mfx780425

谢谢明天会更好zj老师的建议

ykcbf1100

新写一个，全表自动生成。

ykcbf1100

新写一个，全表自动生成。

1. Sub ykcbf()   '//2024.5.20  各月汇总
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Application.ScreenUpdating = False
   
4.     Set sh = ThisWorkbook.Sheets("汇总")
   
5.     ReDim brr(1 To 10000, 1 To 100)
   
6.     m = 2: n = 4
   
7.     bt1 = [{"序号","部门","姓名","身份证号码"}]
   
8.     bt2 = [{"出勤天数","应发金额","实发金额"}]
   
9.     For x = 1 To 4
   
10.         brr(1, x) = bt1(x)
    
11.     Next
    
12.     For Each sht In Sheets
    
13.         If Val(sht.Name) Then
    
14.             With sht
    
15.                 r = .UsedRange.Find("合计").Row
    
16.                 c = .UsedRange.Columns.Count
    
17.                 c1 = Application.WorksheetFunction.Match(bt2(1), .Rows(3), 0)
    
18.                 c2 = Application.WorksheetFunction.Match(bt2(2), .Rows(2), 0)
    
19.                 c3 = Application.WorksheetFunction.Match(bt2(3), .Rows(2), 0)
    
20.                 fn = .[a1].Value
    
21.                 arr = .[a4].Resize(r - 4, c)
    
22.                 For i = 1 To UBound(arr)
    
23.                     s = CStr(arr(i, 4))
    
24.                     If Not d.exists(s) Then
    
25.                         m = m + 1
    
26.                         d(s) = m
    
27.                         brr(m, 1) = m
    
28.                         For j = 2 To 4
    
29.                             brr(m, j) = arr(i, j)
    
30.                         Next
    
31.                     End If
    
32.                     r = d(CStr(arr(i, 4)))
    
33.                     s = fn
    
34.                     If Not d.exists(fn) Then
    
35.                         n = n + 3
    
36.                         d(fn) = n
    
37.                         brr(1, n - 2) = fn
    
38.                         brr(2, n - 2) = bt2(1)
    
39.                         brr(2, n - 1) = bt2(2)
    
40.                         brr(2, n) = bt2(3)
    
41.                     End If
    
42.                     c = d(fn)
    
43.                     brr(r, c - 2) = arr(i, c1)
    
44.                     brr(r, c - 1) = arr(i, c2)
    
45.                     brr(r, c) = arr(i, c3)
    
46.                 Next
    
47.             End With
    
48.         End If
    
49.     Next
    
50.     With sh
    
51.         .UsedRange.Clear
    
52.         .Columns(4).NumberFormatLocal = "@"
    
53.         With .[a1].Resize(m + 1, n)
    
54.             .Value = brr
    
55.             .Borders.LineStyle = 1
    
56.             .HorizontalAlignment = xlCenter
    
57.             .VerticalAlignment = xlCenter
    
58.             .EntireColumn.AutoFit
    
59.             .Columns("D:D").ColumnWidth = 14
    
60.             .Columns("e:az").ColumnWidth = 11
    
61.             With .Font
    
62.                 .Name = "微软雅黑"
    
63.                 .Size = 11
    
64.             End With
    
65.         End With
    
66.         For j = 1 To 4
    
67.             .Cells(1, j).Resize(2).Merge
    
68.         Next
    
69.         For j = 5 To n Step 3
    
70.             .Cells(1, j).Resize(1, 3).Merge
    
71.         Next
    
72.         .[a1].Resize(1, n).Interior.Color = 49407
    
73.         .[e2].Resize(1, n - 4).Interior.Color = 5296274
    
74.         r = .Cells(Rows.Count, 1).End(3).Row
    
75.         .Cells(r + 1, 1) = "合计"
    
76.         .Cells(r + 1, 1).Resize(1, 4).Merge
    
77.         .Cells(r + 1, 5).Resize(1, n - 4).FormulaR1C1 = "=SUM(R3C:R" & "[-1]C)"
    
78.     End With
    
79.     Application.ScreenUpdating = True
    
80.     MsgBox "OK！"
    
81. End Sub
    
82. 
    

复制代码

ykcbf1100

jjmysjg 发表于 2024-5-19 20:42
储老师你好：
如果各表不含“月”，没规律，能达到这个效果吗

15楼代码可以。

chxw68

jjmysjg 发表于 2024-5-19 20:42
储老师你好：
如果各表不含“月”，没规律，能达到这个效果吗

要让代码更好地工作，跟人一样也要为其提供良好的工作条件。

jjmysjg

chxw68 发表于 2024-5-20 21:29
要让代码更好地工作，跟人一样也要为其提供良好的工作条件。

谢谢老师提醒。
取得的报表不规范，有1、2、3的，有一、二、三的，想找个通用的代码，避免老是修改表名