作者Catbert (宅男)
看板Office
标题Re: [问题] excel不一样档案要如何合并呢?
时间Sun Feb 17 19:00:59 2008
※ 引述《ileasa (清纯低假高中妹)》之铭言：
: (若是和其他不同软体互动之问题 请记得一并填写)
: 您所使用的软体为:office excel
: 版本: 2003
: 问题:如果有20个excel的档案
: 然而要在一个新的excel的档案里
: 把那20个档案里面的其中同一列都复制到新的档案里面
: 应该如何做呢?
: 我目前是用最笨的方法就是一个一个档案开启来
: 然後复制之後在到新档案贴上
: 不过做好一天份的档案要花一个小时
: 我总共要做三个月份的
: 可以告诉我比较快的方法吗?
: 谢谢!!
之前帮同事写的程式...
目的是为了合并同一个资料夹下面的所有Excel档成一个
1.开启Excel档
2.点选[工具]→[巨集]→[Visual Basic 编辑器]开启VBA编辑器(VBE)
3.在VBE中：
a.点选[插入]→[模组]
b.点选[工具]→[设定引用项目]，勾选[Microsoft Scripting Runtime]
4.将下面的程式码贴在右边：
==============================================================================
Sub MergeXlsFiles()
Dim myFSO As Scripting.FileSystemObject
Dim myFiles As Scripting.Files
Dim myFile As Scripting.File
Dim filename As String
Dim newfilename As String
Dim newWB As Workbook
Dim currWB As Workbook
Dim myName As Name
Dim i As Integer
Set currWB = ThisWorkbook
Set myFSO = New Scripting.FileSystemObject
newfilename=Mid(currWB.Path,Len(myFSO.GetParentFolderName(currWB.Path))+2)
newfilename = currWB.Path & "\" & InputBox("请输入档案名称",,newfilename)
If (Right(newfilename, 3) <> "xls") Then
newfilename = newfilename & ".xls"
End If
Set newWB = Workbooks.Add
newWB.SaveAs newfilename
Set myFiles = myFSO.GetFolder(ThisWorkbook.Path).Files
For Each myFile In myFiles
If (myFile.Type = "Microsoft Excel 工作表" And _
myFile.Name <> currWB.Name And newWB.Name <> myFile.Name) Then
filename = myFile.Name
Workbooks.Open currWB.Path & "\" & filename, ReadOnly:=True
Workbooks(filename).Worksheets.Copy _
After:=newWB.Worksheets(newWB.Worksheets.Count)
Workbooks(filename).Close savechanges:=False
End If
Next
Application.DisplayAlerts = False
For i = Application.SheetsInNewWorkbook To 1 Step -1
newWB.Worksheets(i).Delete
Next
Application.DisplayAlerts = True
For Each myName In newWB.Names
myName.Delete
Next
newWB.Close savechanges:=True
currWB.Close savechanges:=False
Set newWB = Nothing
Set currWB = Nothing
Set myFile = Nothing
Set myFiles = Nothing
Set myFSO = Nothing
End Sub
============================================================================
这样就会把所有档案合并成一个Excel档^^"
--
跟你的要求是有差啦....^^"
不过...没详细资料我也没得写...﹨(╯▽╰)∕
--
没事多灌水...
多灌水没事...
--
※ 发信站: 批踢踢实业坊(ptt.cc)
◆ From: 221.169.7.130
1F：推 JieJuen:未测试先推 02/17 21:21