麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 請教EXCEL合併 [打印本頁]

作者: twcg 時間: 2010-10-4 21:52 標題: 請教EXCEL合併

請問高手，我總共有368個XLS檔，每個都只有一個SHEET，但我要368個SHEET合併到一個檔，有沒有什麼方法?

作者: GBKEE 時間: 2010-10-5 08:09

回復 1# twcg

Sub Ex()
Dim MergePath As String, FS As Object, MergeWorkbook As Workbook, E
MergePath = "D:\test\" '合併檔案的資料夾
Set FS = CreateObject("Scripting.FileSystemObject").GETFOLDER(MergePath).Files
'FS=合併檔案資料夾中所有檔案物件的集合
Set MergeWorkbook = Workbooks.Add(xlWBATWorksheet) '新開的檔案
Application.ScreenUpdating = False
For Each E In FS
If E Like "*.xls" Then '檔案的副檔名為xls
With Workbooks.Open(E)
.Sheets(1).Copy MergeWorkbook.Sheets(1) '將工作表複製到新開的檔案中
.Close
End With
End If
Next
Application.DisplayAlerts = False
MergeWorkbook.SaveAs MergePath & "合併.XLS" '合併檔存檔
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

複製代碼

作者: ANGELA 時間: 2010-10-5 10:50

回復 2# GBKEE

很好用的功能, 請問是否可以將工作表名稱按原來工作簿名稱命名?

作者: GBKEE 時間: 2010-10-5 11:48

回復 GBKEE

很好用的功能, 請問是否可以將工作表名稱按原來工作簿名稱命名?
ANGELA 發表於 2010-10-5 10:50

With Workbooks.Open(E)
   .Sheets(1).Copy MergeWorkbook.Sheets(1)  '將工作表複製到新開的檔案中
   MergeWorkbook.Sheets(1).Name = E.Name
   .Close
End With

作者: ANGELA 時間: 2010-10-5 12:57

回復 4# GBKEE

可以了, 謝謝版主如此一來就可以把散亂的檔案歸類了,乾淨多了.

作者: twcg 時間: 2010-10-5 13:01

回復 2# GBKEE

請問這要用什麼程式去執行

作者: GBKEE 時間: 2010-10-5 14:29

回復 GBKEE

請問這要用什麼程式去執行
twcg 發表於 2010-10-5 13:01

請先將程式複製到檔案VBA專案裡且修改MergePath 為合併檔案的資料夾為正確的路徑
方法一如圖1

[attach]3000[/attach]

方法二如圖2

[attach]3001[/attach]

方法三如圖3 1.須將滑鼠移動到指定的程式碼 2.按F5 執行指定的程式

[attach]3002[/attach]

作者: b9208 時間: 2010-10-5 23:30

Dear GBKEE
請問是否可以將工作表名稱更改為取原來工作簿檔案名稱之第5碼至第10碼?
例如：
原來工作簿檔案名稱為 2010ABCDE1PRINT.xls
合併後該工作表名稱為 ABCDE1
敬請指導

作者: GBKEE 時間: 2010-10-6 08:11

回復 8# b9208
MergeWorkbook.Sheets(1).Name =Mid( E.Name, 5, 6)

作者: b9208 時間: 2010-10-7 21:17

Dear GBKEE
非常感謝指導，程式碼可以使用。

作者: qwern 時間: 2012-7-9 03:42

請問 Dear GBKEE 那如果我想要他彙整的檔案不要有很多個分頁全部都在同一個分頁只是一直往下貼下去呢??

作者: GBKEE 時間: 2012-7-9 14:40

回復 11# qwern
試試看

Option Explicit
Sub Ex()
Dim MergePath As String, FS As String, Rng As Range
MergePath = "D:\test\" '合併檔案的資料夾
FS = Dir(MergePath & "*.xls") '尋找 xls 檔案
If FS <> "" Then
Set Rng = Workbooks.Add(xlWBATWorksheet).Sheets(1).[a1] '新開的檔案(只有一張工作表)工作表的A1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do
With Workbooks.Open(MergePath & FS)
.Sheets(1).UsedRange.Copy Rng 'MergePath & 中工作表資料複製到Rng
.Close
End With
FS = Dir '繼續尋找(MergePath & "*.XLS")
Set Rng = Rng.End(xlDown).Offset(1) '重設Rng 為往下到最後有資料的儲存格下一個空白之儲存格
Loop While FS <> ""
Application.DisplayAlerts = False
Rng.Parent.Parent.SaveAs MergePath & "合併.xls" '合併檔存檔
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Else
MsgBox MergePath & " 沒有 xls 檔案"
End If
End Sub

複製代碼

PS 按回覆鍵你要回覆者會得到通知

作者: leungko 時間: 2012-7-18 20:50

回復 12# GBKEE

我用了,但是都是說沒有 xls 檔案?{:2_26:}

作者: GBKEE 時間: 2012-7-19 12:48

回復 13# leungko
MergePath = "D:\test\" '合併檔案的資料夾:這裡要有副檔名為 xls 的EXCEL檔案
FS = Dir(MergePath & "*.xls") '尋找 xls 檔案

作者: leungko 時間: 2012-7-20 13:20

回復 14# GBKEE

大大師兄.........可能是我笨......做了好多次都是不行..我是用2003.....{:2_38:}

作者: GBKEE 時間: 2012-7-20 16:09

回復 15# leungko

MergePath = "D:\test\" '合併檔案的資料夾:這裡要有副檔名為 xls 的EXCEL檔案

紅色的路徑可修改為你中PC 有副檔名為 xls EXCEL檔案的資料夾

作者: leungko 時間: 2012-7-23 16:43

Sub Ex()
Dim MergePath As String, FS As String, Rng As Range
MergePath = "C:\Documents and Settings\choikeun\Desktop\New"                                     '合併檔案的資料夾
FS = Dir(MergePath & "*.xls")                            '尋找 xls 檔案
If FS <> "" Then
      Set Rng = Workbooks.Add(xlWBATWorksheet).Sheets(1).[a1] '新開的檔案(只有一張工作表)工作表的A1
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      Do
         With Workbooks.Open(MergePath & FS)
            .Sheets(1).UsedRange.Copy Rng                   'MergePath & 中工作表資料  複製到Rng
            .Close
         End With
         FS = Dir                                           '繼續尋找(MergePath & "*.XLS")
         Set Rng = Rng.End(xlDown).Offset(1)                '重設Rng 為往下到最後有資料的儲存格下一個空白之儲存格
      Loop While FS <> ""
      Application.DisplayAlerts = False
      Rng.Parent.Parent.SaveAs MergePath & "合併.xls"          '合併檔存檔
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
Else
      MsgBox MergePath & " 沒有 xls 檔案"
End If
End Sub
我已經修改了,,但是都不行...........

作者: GBKEE 時間: 2012-7-23 17:05

回復 17# leungko
再改一下試試看
MergePath = "C:\Documents and Settings\choikeun\Desktop\New\" '合併檔案的資料夾

作者: leungko 時間: 2012-7-25 13:13

回復 18# GBKEE

大大的感謝:victory:

作者: lalalada 時間: 2012-7-26 12:08

!!
太棒了

我本來整理csv檔是用複製然後開新分頁再貼上
結果會出現''資源不足...''的錯誤(大概是ram不夠?)
於是只好拆成兩個程式跑
我怎麼沒想到可以用複製分頁的m(_ _)m
感謝!!

作者: p212 時間: 2014-1-22 15:36

本帖最後由 p212 於 2014-1-22 15:39 編輯

回復 4# GBKEE
非常感謝GBKEE超級版主熱心提供的工具
請問GBKEE超級版主
對於待合併的眾檔案，其每一個檔案皆含有相同名稱相同個數的工作表，今若欲指定眾檔案其中相同的一個工作表進行合併，應如何修改2#與4#的語法？
煩請賜教，謝謝！

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)