如何用VBA分类合并工作簿

boyesterday · 发表于 2013-3-15 11:39

本帖最后由 boyesterday 于 2013-3-15 12:40 编辑

我有许多个工作簿，其中最前面的几个字部分一样，我想用vba批量合并这些工作簿，但是分别合并到不同的工作表中（工作簿的名头基本就3、4个，例如：沈阳，北京，上海），标题行还得有（就是第一行不变，只复制数据部分），在网上找了许多，都没用好办法，还得求求各位高手指教！

就是把数据合并到一张表上，按顺序向下粘贴就行，不用相加求和之类的。

№①布鲑鲑 · 发表于 2013-3-15 12:07

呵呵，标题行得还有。。。。。得还有什么？怎么合并，按什么条件合并？相同名称的是否相加？不得而知。。。。

boyesterday · 发表于 2013-3-15 12:42

将所有工作簿，按照沈阳、上海、北京，合并到三个工作表里，保留标题行，数据部分依次粘贴下来

zhaogang1960 · 发表于 2013-3-15 13:02

请测试:

Sub Macro1()
Dim p$, f$, d As Object, arr, brr(), crr(1 To 65530, 1 To 5), m&(), i&, j&, l&, t
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
ReDim brr(1 To Sheets.Count)
For i = 1 To Sheets.Count
With Sheets(i)
d(.Name) = i
brr(i) = crr
.UsedRange.Offset(1).ClearContents
End With
Next
ReDim m(1 To Sheets.Count)
p = ThisWorkbook.Path & ""
f = Dir(p & "*.xls")
Do While f <> ""
If f <> ThisWorkbook.Name Then
For l = 2 To Len(f) - 4
t = d(Left(f, l))
If t <> "" Then
With GetObject(p & f)
arr = .Sheets(1).[a1].CurrentRegion
For i = 2 To .Sheets(1).[b65536].End(xlUp).Row
m(t) = m(t) + 1
brr(t)(m(t), 1) = m(t)
For j = 2 To 5
brr(t)(m(t), j) = arr(i, j)
Next
Next
.Close False
End With
Exit For
End If
Next
End If
f = Dir
Loop
For i = 1 To Sheets.Count
If m(i) Then Sheets(i).[a2].Resize(m(i), 5) = brr(i)
Next
Application.ScreenUpdating = True
End Sub

复制代码

zhaogang1960 · 发表于 2013-3-15 13:05

为了使得三个字或以上的城市名也可以统计，请事先把所有城市名定义为工作表，就像附件中已经定义了3个工作表一样
请看附件

例子.rar (22.85 KB, 下载次数: 43)

№①布鲑鲑 · 发表于 2013-3-15 13:10

试试看。。。。。

		自动登录	找回密码
密码			免费注册

[求助] 如何用VBA分类合并工作簿