关于多工作表内容汇总到一张表，已查询好久，没有解决办法，拜托各位大虾帮忙

xyz767

公司的场所比较多，用的工人还不太固定，所以每个场所用一张工作表来做工资。
这就需要把每个场所的工资，按照人名把不同场所的工资汇总到一张工作表里。（由于每月工人名单不同，所以姓名栏里无法固定内容）
在论坛里查了整整一天，发现很多帖子有点思路，给了很多帮助
但小弟愚蠢，怎也弄不出来，着急要用，所以厚颜拜托各位大虾帮忙。

附件已上传。
在这里先谢过了。

cqxr

原帖由 xyz767 于 2011-4-18 17:12 发表
公司的场所比较多，用的工人还不太固定，所以每个场所用一张工作表来做工资。
这就需要把每个场所的工资，按照人名把不同场所的工资汇总到一张工作表里。（由于每月工人名单不同，所以姓名栏里无法固定内容）
在论 ...

建议到VBA中求解

xyz767

只能用VBA吗？那东东更弄不明白了
拜托大家了

ghfmac

我们使用的是汇总大师！

xiaoza

表的格式就这样不用动了。
每个人的番号是唯一的，用“番号”做关键字用vlookup函数把“场所一”“场所二”“场所三”等等后面的明细表的数据链接到汇总表里就行了呀~

xyz767

原帖由 xiaoza 于 2011-4-19 10:19 发表
表的格式就这样不用动了。
每个人的番号是唯一的，用“番号”做关键字用vlookup函数把“场所一”“场所二”“场所三”等等后面的明细表的数据链接到汇总表里就行了呀~

但是每个月用的人是不固定的，如果连没有工资的人一起全都列出来的话，表内容会太大了。
不过还是谢谢了。非常感谢。

xyz767

拜托大家了

xyz767

又憋了一天，还是没有进展，再次拜托各位帮忙 谢谢。

ykcbf1100

借题练习，一键生成全表

ykcbf1100

1. Sub ykcbf()   '//2025.3.25    多表排重汇总
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set Sh = ThisWorkbook.Sheets("工资汇总")
   
6.     ReDim brr(1 To 10000, 1 To 100)
   
7.     m = 2: n = 3
   
8.     bt = [{"手挡","時間","金額"}]
   
9.     On Error Resume Next
   
10.     For Each sht In Sheets
    
11.         If InStr("人员编号|工资汇总", sht.Name) = 0 Then
    
12.             arr = sht.UsedRange
    
13.             brr(1, 1) = arr(1, 2) & arr(1, 3): brr(1, 2) = arr(1, 4): brr(1, 3) = arr(1, 5)
    
14.             For x = 1 To 3
    
15.                 brr(1, n + x) = sht.Name
    
16.                 brr(2, n + x) = bt(x)
    
17.                 brr(2, x) = arr(2, x + 2)
    
18.             Next
    
19.             n = n + 3
    
20.             For i = 4 To UBound(arr)
    
21.                 s = arr(i, 3)
    
22.                 If arr(i, 3) <> Empty Then
    
23.                     If Not d.exists(s) Then
    
24.                         m = m + 1
    
25.                         d(s) = m
    
26.                         brr(m, 1) = Format(arr(i, 3), "000000")
    
27.                         brr(m, 2) = arr(i, 4)
    
28.                         brr(m, 3) = arr(i, 5)
    
29.                     End If
    
30.                     r = d(arr(i, 3))
    
31.                     brr(r, n - 2) = arr(i, 2)
    
32.                     brr(r, n - 1) = arr(i, 102)
    
33.                     brr(r, n) = arr(i, 103)
    
34.                 End If
    
35.             Next
    
36.         End If
    
37.     Next
    
38.     For x = 1 To 3
    
39.         brr(1, n + x) = "合计"
    
40.         brr(2, n + x) = bt(x)
    
41.     Next
    
42.     n = n + 3
    
43.     With Sh
    
44.         .UsedRange.Clear
    
45.         .Cells.Interior.ColorIndex = 0
    
46.         .[a1].Resize(2, n).Interior.Color = 49407
    
47.         .[a3].Resize(m - 2, 1).Interior.Color = 5296274
    
48.         .Columns(1).NumberFormatLocal = "@"
    
49.         With .[a1].Resize(m, n)
    
50.             .Value = brr
    
51.             .Borders.LineStyle = 1
    
52.             .HorizontalAlignment = xlCenter
    
53.             .VerticalAlignment = xlCenter
    
54.             With .Font
    
55.                 .Name = "微软雅黑"
    
56.                 .Size = 11
    
57.             End With
    
58.         End With
    
59.         For j = 4 To n Step 3
    
60.             .Cells(1, j).Resize(, 3).Merge
    
61.         Next
    
62.         For i = 3 To m
    
63.             For x = 1 To 3
    
64.                 Sum = 0
    
65.                 For j = 3 + x To n - 6 + x Step 3
    
66.                     Sum = Sum + .Cells(i, j).Value * 1
    
67.                 Next
    
68.                 .Cells(i, n - 3 + x) = Sum
    
69.             Next
    
70.         Next
    
71.         Set Rng = .[a3].Resize(m - 2, n)
    
72.         Rng.Sort Rng.Columns(1), 1
    
73.     End With
    
74.     Set d = Nothing
    
75.     Application.ScreenUpdating = True
    
76.     MsgBox "OK！"
    
77. End Sub
    

复制代码