請教EXCEL合併 - Excel程式區 - 麻辣家族討論版版

qwern

小學生 Rank: 1

帖子: 11
主題: 1
精華: 0
積分: 19
點名: 0
作業系統: excel
軟體版本: 2010
閱讀權限: 10
性別: 男
來自: 台灣
註冊時間: 2012-7-8
最後登錄: 2012-9-5

11^# 跳轉到 »

發表於 2012-7-9 03:42 | 只看該作者

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

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

12^#

發表於 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 按回覆鍵你要回覆者會得到通知

TOP

leungko

中學生 Rank: 2

帖子: 12
主題: 3
精華: 0
積分: 53
點名: 0
作業系統: xp
軟體版本: off 2003
閱讀權限: 20
註冊時間: 2012-7-4
最後登錄: 2023-5-12

13^#

發表於 2012-7-18 20:50 | 只看該作者

回復 12# GBKEE

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

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

14^#

發表於 2012-7-19 12:48 | 只看該作者

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

TOP

leungko

中學生 Rank: 2

帖子: 12
主題: 3
精華: 0
積分: 53
點名: 0
作業系統: xp
軟體版本: off 2003
閱讀權限: 20
註冊時間: 2012-7-4
最後登錄: 2023-5-12

15^#

發表於 2012-7-20 13:20 | 只看該作者

回復 14# GBKEE

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

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

16^#

發表於 2012-7-20 16:09 | 只看該作者

回復 15# leungko

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

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

TOP

leungko

中學生 Rank: 2

帖子: 12
主題: 3
精華: 0
積分: 53
點名: 0
作業系統: xp
軟體版本: off 2003
閱讀權限: 20
註冊時間: 2012-7-4
最後登錄: 2023-5-12

17^#

發表於 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
我已經修改了,,但是都不行...........

TOP

GBKEE