多个表头不同文件如何合并成一个文件，找了一圈没适合的帖子

Mapleaf12138 · 发表于 2018-10-18 22:37

附件，按钮在合并.xls里

ttcttyn · 发表于 2018-10-18 23:21

Mapleaf12138 发表于 2018-10-18 22:37
附件，按钮在合并.xls里

刚想说复制了代码运行看不到表头不知道数据是什么，翻过来看有附件。非常感谢！

ttcttyn · 发表于 2018-10-18 23:23

Mapleaf12138 发表于 2018-10-18 22:37
附件，按钮在合并.xls里

非常感谢！

liuxi001 · 发表于 2018-10-19 01:05

如果只是合并，这几天刚好写了一个不限表头位置和列字段顺序的代码，希望对你有用。

补充内容 (2018-10-24 14:16):
http://club.excelhome.net/thread-1441344-1-1.html

补充内容 (2018-11-30 18:14):
原贴七楼更新，加入数据来源及序号

ttcttyn · 发表于 2018-10-22 14:01

本帖最后由 ttcttyn 于 2018-10-22 14:03 编辑

liuxi001 发表于 2018-10-19 01:05
如果只是合并，这几天刚好写了一个不限表头位置和列字段顺序的代码，希望对你有用。

这个非常不错，想问下合并的那个表第一行标题顺序怎么乱斗可以合并吗，字段只要含有关键字都能合并？
我合并了一个自己的数据，数值的一列头几行会变成时间，这是怎么回事，文件格式和其他的是一样的，想上图发现不能编辑帖子了这是合并后的样子

这是数据源

lrh788 · 发表于 2018-10-22 14:09

学习了！！！

cjc209 · 发表于 2018-10-22 18:36

Sub 动态字段多薄多表合并为一表()
Dim d, ar, br, sh As Worksheet, cr()
Set d = CreateObject("Scripting.Dictionary")
ThisWorkbook.Sheets.Add
ActiveSheet.Name = "合并结果"
bth = Val(Application.InputBox("请输入需要的字段名所在的行号：", "默认值", "1"))
Application.ScreenUpdating = False
p = ThisWorkbook.Path & ""
f = Dir(p & "*.xls*")
Do While f <> ""
If f <> ThisWorkbook.Name Then
With Workbooks.Open(p & f)
For Each sh In Sheets
qsl = sh.UsedRange.Column
zdl = sh.UsedRange.Columns.Count + sh.UsedRange.Column - 1
qsh = bth
zdh = sh.Cells(65536, qsl).End(xlUp).Row
If sh.Name <> "合并结果" Then
If zdh > 1 Then
ar = sh.Cells(qsh, qsl).Resize(zdh - qsh + 1, zdl)
For i = 1 To UBound(ar, 2)
d(ar(1, i)) = 0
Next
End If
End If
Next
.Close 0
End With
End If
f = Dir
Loop
ReDim br(1 To 60000, 1 To d.Count): m = 1
For i = 1 To d.Count
d(d.keys()(i - 1)) = i
br(1, i) = d.keys()(i - 1)
Next
p = ThisWorkbook.Path & ""
f = Dir(p & "*.xls*")
Do While f <> ""
If f <> ThisWorkbook.Name Then
With Workbooks.Open(p & f)
For Each sh In Sheets
qsl = sh.UsedRange.Column
zdl = sh.UsedRange.Columns.Count + sh.UsedRange.Column - 1
qsh = bth
zdh = sh.Cells(65536, qsl).End(xlUp).Row
If sh.Name <> "合并结果" Then
If zdh > 1 Then
ar = sh.Cells(qsh, qsl).Resize(zdh - qsh + 1, zdl)
For i = 2 To UBound(ar)
m = m + 1
For j = 1 To UBound(ar, 2)
br(m, d(ar(1, j))) = ar(i, j)
ReDim Preserve cr(1 To m)
If m = 2 Then
cr(1) = "数据来源"
End If
cr(m) = f & "_" & sh.Name
Next j
Next i
End If
End If
Next
.Close 0
End With
End If
f = Dir
Loop
With ActiveSheet
.UsedRange.ClearContents
.[a1].Resize(m, UBound(br, 2)) = br
.[a1].Offset(0, UBound(br, 2) - 1).Resize(m, 1) = Application.Transpose(cr)
End With
LastRow = ActiveSheet.UsedRange.Rows.Count
LastRow = LastRow + ActiveSheet.UsedRange.Row - 1
For r = LastRow To 1 Step -1
If WorksheetFunction.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
LastColumn = ActiveSheet.UsedRange.Columns.Count
LastColumn = LastColumn + ActiveSheet.UsedRange.Column
For c = LastColumn To 1 Step -1
If WorksheetFunction.CountA(Columns(c)) = 0 Then Columns(c).Delete
Next c
Application.ScreenUpdating = True
MsgBox "合并完成！"
End Sub

复制代码

通用型动态字段合并多薄多表

cjc209 · 发表于 2018-10-22 18:41

liuxi001 发表于 2018-10-19 01:05
如果只是合并，这几天刚好写了一个不限表头位置和列字段顺序的代码，希望对你有用。

情况一变又得该代码不具备通用型

cjc209 · 发表于 2018-10-22 18:42

cjc209 发表于 2018-10-22 18:41
情况一变又得该代码不具备通用型

我发的就是这一类的通用型的当成工具使用代码还在审查

cjc209 · 发表于 2018-10-22 18:44

cjc209 发表于 2018-10-22 18:42
我发的就是这一类的通用型的当成工具使用代码还在审查

就连表头字段都是自动生成只是需要指出字段在哪一行就ok了还标明了数据的来源

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

[求助] 多个表头不同文件如何合并成一个文件，找了一圈没适合的帖子

评分

评分

[求助] 多个表头不同文件如何合并成一个文件 ，找了一圈没适合的帖子

评分

评分

[求助] 多个表头不同文件如何合并成一个文件，找了一圈没适合的帖子