如何将分表汇总到总表_如何快速将几个分表合并到一张表

展开全部

execl表格32313133353236313431303231363533e58685e5aeb931333365656636的合并从简单方面说，只需要复制粘贴每一张表格到一个统一的工作表即可，但是从工作方面考虑，表格中的重复项是否需要合并，重复项的数据是否需要累计汇总，每个表格不同的项目怎么筛选并追加到汇总表中等问题，都是合并多个工作表时，我们需要考虑的问题。另外如果工作表只有几张还可以，如果工作表有几百张都需要汇总怎么办？手动复制明显效率低下，而且错误率高。怎么办？

如何快速、高效的合并多个工作表呢？那么采用vba编程方式来解决就是我们不二之选。

以下的例子就是一个多工作表合并的实例。

实例中采用VBA宏方式，先建立汇总按钮，然后绑定编辑好的宏即可，多少个表都可以，只要execl能容纳下，每个表格必须格式一样，汇总表在任何位置都可以。汇总的功能如下，汇总表把每一页表格相同项合并，数量累加，同时将每一个表的新增项添加入汇总表，同时累加。希望这个例子能对你的工作有帮助。

实例如下：

某连锁社区超市，不同分店的库存表需要汇总，工作表数据既有重复的又有不同的。工作表有4张(模拟四个分店)，汇总到一个表中。

1、汇总后的汇总表，按汇总按钮进行对工作表汇总，按清除按钮清楚汇总结果。

其中各工作表格式：

表三、表四格式相同略过。

VBA代码：

Sub 合并()Dim i As IntegerDim j As IntegerDim k As IntegerDim l As IntegerDim n As IntegerDim a() As VariantDim b() As VariantDim c(1 To 1000, 1 To 3) As Variant ScreenUpdating = False'-------------------------------------------------------For i = 1 To Worksheets.Count                      '循环工作簿中所有工作表         If ActiveSheet.Name <> Worksheets(i).Name Then '判断是否为汇总表，是的                                                   '话进行下一个表单。        a() = Worksheets(i).UsedRange.Value '获取工作表数据    Else        GoTo nextsheet    End If             If i = 1 Then                              '判断是否为第一张表，是的话，        b() = Worksheets(i).UsedRange.Value    '直接复制并进行下一个表。        GoTo nextsheet    End If'-------------------------------------------------------    For j = LBound(a) + 1 To UBound(a)         '汇总同类数量                     For k = LBound(b) + 1 To UBound(b)                         If a(j, 1) = b(k, 1) And a(j, 2) = b(k, 2) Then                b(k, 3) = b(k, 3) + a(j, 3)                Exit For            End If                         Next'-------------------------------------------------------        If k = UBound(b) + 1 Then                    '汇总新增加种类            c(l + 1, 1) = a(j, 1)            c(l + 1, 2) = a(j, 2)            c(l + 1, 3) = a(j, 3)            l = l + 1        End If            Next'-------------------------------------------------------    Range("z1").Resize(UBound(b), UBound(b, 2)) = b() '增加汇总表空间    b() = Application.WorksheetFunction.Transpose(b)    ReDim Preserve b(1 To 3, 1 To UBound(b, 2) + l)    b() = Application.WorksheetFunction.Transpose(b)    b() = Range("z1").Resize(UBound(b), UBound(b, 2))    Range("z1").Resize(UBound(b), UBound(b, 2)).Clear'-------------------------------------------------------    For n = 1 To l                                    '合并新增加种类到汇总表                         b(UBound(b) - l + n, 1) = c(n, 1)        b(UBound(b) - l + n, 2) = c(n, 2)        b(UBound(b) - l + n, 3) = c(n, 3)                 Next'-------------------------------------------------------    Erase c()                                         '清空临时数据    l = 0     nextsheet: Next'-------------------------------------------------------Range("A1").Resize(UBound(b), UBound(b, 2)) = b()     '生成汇总表 ScreenUpdating = ture End Sub