合并相同列的在同一路径下的多个工作簿到一个工作表里（仅保留第一个表头）

liubuyao

姓  名	专业
周江丽	土木工程

上图为表一

姓  名	专业
包云鹏	土木工程

上图为表二

姓  名	专业
周江丽	土木工程
包云鹏	土木工程

上图为合并后的结果表三

附件如下
附件.zip (10.67 KB, 下载次数: 96)

2012-9-23 17:02 上传

点击文件名下载附件

yangyangzhifeng

试试看

1. Sub test()
   
2.     Dim ph$, fn$, f$, i&, j&, n&, ar, br(1 To 65536, 1 To 2)
   
3.     f = ThisWorkbook.Name
   
4.     ph = ThisWorkbook.Path & ""
   
5.     fn = Dir(ph & "*.xls")
   
6.     Do While fn <> ""
   
7.         If fn <> f Then
   
8.         Workbooks.Open ph & fn
   
9.             ar = ActiveWorkbook.Sheets(1).Range("a1").CurrentRegion
   
10.             For i = 2 To UBound(ar)
    
11.                 n = n + 1
    
12.                 br(n, 1) = ar(i, 1): br(n, 2) = ar(i, 2)
    
13.             Next
    
14.             ActiveWorkbook.Close False
    
15.         End If
    
16.         fn = Dir()
    
17.     Loop
    
18.     Sheet1.Range("a2:b65536").ClearContents
    
19.     Sheet1.Range("a2").Resize(n, 2) = br
    
20. End Sub
    

复制代码

yangyangzhifeng

请见附件
3.rar (9.66 KB, 下载次数: 217)

2012-9-23 17:16 上传

点击文件名下载附件

amazeyeli

liubuyao

yangyangzhifeng 发表于 2012-9-23 17:15
试试看

可以用……谢谢！！谢谢！！表情点不出来不能表示流泪了

liubuyao

amazeyeli 发表于 2012-9-23 17:23

嘿嘿，学习了，这个很像Access的查询设计么~~~~~

houlinsong

如果三列四列，代码如何写

lrh788

学习了！！