已知职工各月工资，汇总全部职工工资到一张表中显示

冥__冥

我这里有职工一年的工资台账，台账有些部门是每个职工在一张表里，有些是一张表放了几个员工的工资。

格式如下   姓名  XXX  
                     1月
                      2月
                      3月
                    ……


有一张汇总表
格式如下      姓名1      1月   2月   3月   4月 ……
                    姓名2
                    姓名3
                    ……

要求是，将各个员工的分表汇总到汇总表中
谢谢各位大侠！
汇总.7z (23.24 KB, 下载次数: 56)

2012-9-10 11:09 上传

点击文件名下载附件

sunya_0529

1. Option Explicit
   
2. 
   
3. Sub PickData()
   
4. On Error Resume Next
   
5. Dim strPath, wbkTemp As Workbook, wstTemp As Worksheet
   
6. Dim rngTemp As Range, strAdd$, i%, j%, arrTemp(1 To 999, 1 To 18)
   
7. strPath = Application.GetOpenFilename(FileFilter:="Excel文件(*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="请选择文件——")
   
8. If strPath = False Then Exit Sub
   
9. Set wbkTemp = Workbooks.Open(Filename:=strPath, UpdateLinks:=False, ReadOnly:=True)
   
10. 'wbkTemp.Activate
    
11. With ThisWorkbook.Sheets("Sheet1")
    
12.   For Each wstTemp In wbkTemp.Sheets
    
13.     Set rngTemp = wstTemp.Cells.Find("姓名", LookIn:=xlValues, LookAt:=xlWhole)
    
14.     If Not rngTemp Is Nothing Then
    
15.       strAdd = rngTemp.Address
    
16.       Do
    
17.         i = i + 1
    
18.         j = rngTemp.Row
    
19.         arrTemp(i, 1) = i + IIf(IsNumeric(.[A65536].End(xlUp).Value), .[A65536].End(xlUp).Value, 0) '序号
    
20.         arrTemp(i, 2) = "" '个人编号
    
21.         arrTemp(i, 3) = Replace(wstTemp.Cells(j, 3), " ", "") '姓名
    
22.         arrTemp(i, 4) = wstTemp.Cells(j + 18, 8) '申报收入
    
23.         arrTemp(i, 5) = wstTemp.Cells(j + 5, 10) '一月
    
24.         arrTemp(i, 6) = wstTemp.Cells(j + 6, 10) '二月
    
25.         arrTemp(i, 7) = wstTemp.Cells(j + 7, 10) '三月
    
26.         arrTemp(i, 8) = wstTemp.Cells(j + 8, 10) '四月
    
27.         arrTemp(i, 9) = wstTemp.Cells(j + 9, 10) '五月
    
28.         arrTemp(i, 10) = wstTemp.Cells(j + 10, 10) '六月
    
29.         arrTemp(i, 11) = wstTemp.Cells(j + 11, 10) '七月
    
30.         arrTemp(i, 12) = wstTemp.Cells(j + 12, 10) '八月
    
31.         arrTemp(i, 13) = wstTemp.Cells(j + 13, 10) '九月
    
32.         arrTemp(i, 14) = wstTemp.Cells(j + 14, 10) '十月
    
33.         arrTemp(i, 15) = wstTemp.Cells(j + 15, 10) '十一月
    
34.         arrTemp(i, 16) = wstTemp.Cells(j + 16, 10) '十二月
    
35.         arrTemp(i, 17) = wstTemp.Cells(j + 17, 10) '合计
    
36.         arrTemp(i, 18) = "" '差异
    
37.         Set rngTemp = wstTemp.Cells.FindNext(rngTemp)
    
38.       Loop While Not rngTemp Is Nothing And strAdd <> rngTemp.Address
    
39.     End If
    
40.   Next
    
41.   .[A65536].End(xlUp).Offset(1, 0).Resize(i, 1).EntireRow.Insert
    
42.   .[A65536].End(xlUp).Offset(1, 0).Resize(i, 18) = arrTemp
    
43. End With
    
44. wbkTemp.Close savechanges:=False
    
45. Set wbkTemp = Nothing
    
46. End Sub

复制代码

ritagu

非常感谢哦
希望是我想要的