多个工作薄中的部分数据汇总为一个总表

KCCKSCF

如何将附件中1队~5队工作薄中的人员姓名及月度奖金这两列汇总到“汇总表”。

请高手帮忙！

cf7315752

你做的这表也太奇葩了吧 格式那么不规范 怎么汇总 编程都没法编 你得起码有一个稍微统一点的格式 才能考虑编程实现

cf7315752

1、请统一每个子表中的Sheet“总表”格式，格式如下：

部门

姓名

工资

绩效工资

月度奖金

应付工资

对比上月增减

上月奖金

说明

2、操作时，需要打开所有需要汇总的子表和汇总表，点击按钮即可实现汇总，具体请参见附件附代码：
Sub 汇总数据到一个表中()
On Error Resume Next
Application.ScreenUpdating = False
Dim Workbook_name As String
Dim Sheet_name As String
Dim ActSheet_name As String
Dim sht As Worksheet
Dim wb As Workbook
Dim hmax As Integer
Workbook_name = ActiveWorkbook.Name
ActSheet_name = ActiveSheet.Name
Sheet_name = "总表"     '每个Workbook中有一个  Sheet（总表），程序会将其中的信息进行汇总
For Each wb In Workbooks
If Workbook_name <> wb.Name Then
wb.Activate
For Each sht In Sheets
hmax = Workbooks(Workbook_name).Sheets(ActSheet_name).UsedRange.Rows.Count
If sht.Name = Sheet_name Then
ActiveSheet.Range("A2").Resize(ActiveSheet.Range("A65535").End(xlUp).Row - 1, ActiveSheet.UsedRange.Columns.Count).Copy Workbooks(Workbook_name).Sheets(ActSheet_name).Range("A" & hmax + 1)
End If
Next
End If
Next
Workbooks(Workbook_name).Activate
Application.ScreenUpdating = True
End Sub

cf7315752

更改了一下代码，可以实现要求，具体见附件

Sub 汇总数据到一个表中()
On Error Resume Next
Application.ScreenUpdating = False
Dim Workbook_name As String
Dim Sheet_name As String
Dim ActSheet_name As String
Dim sht As Worksheet
Dim wb As Workbook
Dim hmax As Integer
Dim cmax As Integer
Dim rng As Range
Dim i As Integer
Dim j1 As Integer
Dim j2 As Integer

Workbook_name = ActiveWorkbook.Name
ActSheet_name = ActiveSheet.Name
Sheet_name = "总表"     '每个Workbook中有一个  Sheet（总表），程序会将其中的信息进行汇总
For Each wb In Workbooks
If Workbook_name <> wb.Name Then
wb.Activate
For Each sht In Sheets
hmax = Workbooks(Workbook_name).Sheets(ActSheet_name).UsedRange.Rows.Count
If sht.Name = Sheet_name Then
cmax = ActiveSheet.UsedRange.Columns.Count
For i = 1 To cmax
If ActiveSheet.Cells(1, i) = "姓名" Then
j1 = i
ElseIf ActiveSheet.Cells(1, i) = "月度奖金" Then
j2 = i
End If
Next
Set rng = Union(ActiveSheet.Cells(2, j1).Resize(ActiveSheet.Range("A65535").End(xlUp).Row - 1, 1), ActiveSheet.Cells(2, j2).Resize(ActiveSheet.Range("A65535").End(xlUp).Row - 1, 1))
rng.Copy Workbooks(Workbook_name).Sheets(ActSheet_name).Range("A" & hmax + 1)
Set rng = Nothing
End If
Next
End If
Next
Workbooks(Workbook_name).Activate
Application.ScreenUpdating = True
End Sub

KCCKSCF

cf7315752 发表于 2014-9-24 00:19
更改了一下代码，可以实现要求，具体见附件

Sub 汇总数据到一个表中()

非常好用，十分感谢！
大侠，能否做到：只是将希望汇总的分表放到一个文件夹中，不用打开各分表即可汇总。就像附件那样。

cf7315752

KCCKSCF 发表于 2014-9-24 09:16
非常好用，十分感谢！
大侠，能否做到：只是将希望汇总的分表放到一个文件夹中，不用打开各分表即可汇总 ...

联系QQ529039284，我没太懂你的意思，我的理解是：
每个表中如果有数据，就把其中的A到I列汇总到一张表中，没有数据就跳过：

编号

年度

拨付单位

姓名

住址

补助金额

发放形式

拨付时间

区划简码

我第一次写的那段稍微改一下，就可以实现。

cf7315752

KCCKSCF 发表于 2014-9-24 09:16
非常好用，十分感谢！
大侠，能否做到：只是将希望汇总的分表放到一个文件夹中，不用打开各分表即可汇总 ...

已弄完，参见附件

Sub 汇总()
Dim myPath As String
Dim myFile As String
Dim wk As Workbook
Dim sht As Worksheet
Dim Workbook_name As String
Dim Sheet_name As String
Dim ActSheet_name As String
Dim hmax As Integer
Dim cmax As Integer
Dim rng As Range
Dim i As Integer
Dim j1 As Integer
Dim j2 As Integer
Application.ScreenUpdating = False
Workbook_name = ActiveWorkbook.Name
ActSheet_name = ActiveSheet.Name
Sheet_name = "总表"     '每个Workbook中有一个  Sheet（总表），程序会将其中的信息进行汇总
myPath = ThisWorkbook.Path & "\分表\"
myFile = Dir(myPath & "*.xls")
Do While myFile <> ""
If myFile <> Workbook_name Then
Set wk = Workbooks.Open(myPath & myFile)
For Each sht In Sheets
hmax = Workbooks(Workbook_name).Sheets(ActSheet_name).UsedRange.Rows.Count
If sht.Name = Sheet_name Then
cmax = ActiveSheet.UsedRange.Columns.Count
For i = 1 To cmax
If ActiveSheet.Cells(1, i) = "姓名" Then
j1 = i
ElseIf ActiveSheet.Cells(1, i) = "月度奖金" Then
j2 = i
End If
Next
Set rng = Union(ActiveSheet.Cells(2, j1).Resize(ActiveSheet.Range("A65535").End(xlUp).Row - 1, 1), ActiveSheet.Cells(2, j2).Resize(ActiveSheet.Range("A65535").End(xlUp).Row - 1, 1))
rng.Copy Workbooks(Workbook_name).Sheets(ActSheet_name).Range("A" & hmax + 1)
Set rng = Nothing
End If
Next
Workbooks(myFile).Close False
End If
myFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "汇总完毕！", 64, "提示"
End Sub

KCCKSCF

cf7315752 发表于 2014-9-24 11:41
已弄完，参见附件

Sub 汇总()

已接近完美了，多谢大侠帮助！
在演示中还是发现一个小问题：“5队”工作薄中，如果保存界面为“财务”SHEET时，汇总表中得到的是“财务”中的E列数值，而不是当月奖金的数值；也就是说，不能自动全部选取各工作薄中“总表”的奖金。能不能让汇总表只从各工作薄上“总表”上筛选汇总，不论各工作薄保存界面是哪个“SHEET "

cf7315752

KCCKSCF 发表于 2014-9-26 11:25
已接近完美了，多谢大侠帮助！
在演示中还是发现一个小问题：“5队”工作薄中，如果保存界面为“财务”S ...

变量没设置正确，已更正，你再试试。 多个工作薄汇总 更正.rar (49.53 KB, 下载次数: 98)

2014-9-26 12:53 上传

点击文件名下载附件

KCCKSCF

非常完美，多谢大侠仗义相助！！！