[發問] 開啟中的工作簿合併至另一工作簿中

帖子: 11
主題: 1
精華: 0
積分: 17
點名: 0
作業系統: WindowsXP
軟體版本: 2003
閱讀權限: 10
性別: 女
註冊時間: 2011-9-29
最後登錄: 2013-5-22

論壇榮譽勳章論壇贊助勳章

10^#

發表於 2011-10-4 08:16 | 只看該作者

回復 9# GBKEE

謝謝GBKEE版大，我後來發現，可能是我要合併的工作簿格式太過複雜(由.csv檔跑過巨集，在另存為.xls檔)，EXCEL記憶體負荷不了，所以才會一值跑出'1004'執行階段錯誤！後來我改為先將csv檔資料合併到excel工作頁，在用巨集做資料處理，就OK了！不過還是謝謝版大，讓我又學到一招了！

waterful.tw

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兔年全勤獎章

9^#

發表於 2011-10-3 16:20 | 只看該作者

本帖最後由 GBKEE 於 2011-10-3 17:16 編輯

回復 8# waterful.tw

MyPath = ThisWorkbook.Path & "\"
fs = Dir(MyPath & "*.xls")

請加上  ChDir  MyPath    改變目前的目錄  來修正錯誤

如目前的目錄或檔案夾在 ThisWorkbook.Path & "\"
With Workbooks.Open(fs) -> 開啟目前的目錄下檔案fs  所以不會有錯誤.
如目錄或檔案夾不在 ThisWorkbook.Path & "\"
也可修正為 With Workbooks.Open(MyPath & fs)    ->如 : d:\test\ fs
以避免目前的目錄或檔案夾不是在  ThisWorkbook.Path -> With Workbooks.Open(fs) 會產生錯誤

可用 MsgBox  CurDir  查看目前的目錄或檔案夾
CurDir函數  ->傳回一個 Variant (String)，用來代表目前的路徑。
Excel 開啟時會依如圖設立目前的目錄或檔案夾

帖子: 11
主題: 1
精華: 0
積分: 17
點名: 0
作業系統: WindowsXP
軟體版本: 2003
閱讀權限: 10
性別: 女
註冊時間: 2011-9-29
最後登錄: 2013-5-22

論壇榮譽勳章論壇贊助勳章

8^#

發表於 2011-10-3 09:03 | 只看該作者

Dear Hsieh & GBKEE版大，
我已複製您的程式，並修改MyPath的型態為String，結果現在是在with那行出現執行階段錯誤'1004'=>找不到檔案或檔名錯誤！
奇怪的是，"C:\Documents and Settings\Administrator\桌面\try and error\*.xls"不是電腦自己抓的? 檔名"*.xls"應該也沒錯阿? 感覺越來越亂了...orz

waterful.tw

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兔年全勤獎章

7^#

發表於 2011-10-1 14:54 | 只看該作者

回復 3# waterful.tw
Wb.Sheets("Sheet2").Copy After:=Workbooks("統計.xls").Sheets(2) '錯誤9 ->沒有2 , 會有1  你用 Sheets.Count替代也行

Dim MyPath As Long       '  -> 數字  Long (長整數)變數係以範圍從 -2,147,483,648 到 2,147,483,647 之 32 位元 (4 個位元組) 有號數字形式儲存。
Set MyBook = ThisWorkbook
MyPath = MyBook.Path & "\"                                  '當然是型態不符
Dim MyPath As String  ->應修改維字元
'String之字元碼的範圍從 0 到 255。字元集的前 128 個字元 ( 0 到 127 ) 對應於標準的 U.S 鍵盤上的字元與符號

帖子: 11
主題: 1
精華: 0
積分: 17
點名: 0
作業系統: WindowsXP
軟體版本: 2003
閱讀權限: 10
性別: 女
註冊時間: 2011-9-29
最後登錄: 2013-5-22

論壇榮譽勳章論壇贊助勳章

6^#

發表於 2011-10-1 09:29 | 只看該作者

sorry回復到一半，等我用Hsieh版大的方法試試，有問題再來麻煩囉~

waterful.tw

帖子: 11
主題: 1
精華: 0
積分: 17
點名: 0
作業系統: WindowsXP
軟體版本: 2003
閱讀權限: 10
性別: 女
註冊時間: 2011-9-29
最後登錄: 2013-5-22

論壇榮譽勳章論壇贊助勳章

5^#

發表於 2011-10-1 09:27 | 只看該作者

謝謝Hsieh 版大，

waterful.tw

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 262
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-10-25

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

4^#

發表於 2011-9-30 19:30 | 只看該作者

Sub ex()
Dim MyPath As String, fs As String, MySht As Worksheet
MyPath = ThisWorkbook.Path & "\"
fs = Dir(MyPath & "*.xls")
Do Until fs = ""
If fs <> ThisWorkbook.Name Then
With Workbooks.Open(fs)
Set MySht = .Sheets(2) '要複製的工作表
MySht.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Replace(fs, ".xls", "")
.Close
End With
End If
fs = Dir
Loop
End Sub

複製代碼

回復 3# waterful.tw

學海無涯_不恥下問

帖子: 11
主題: 1
精華: 0
積分: 17
點名: 0
作業系統: WindowsXP
軟體版本: 2003
閱讀權限: 10
性別: 女
註冊時間: 2011-9-29
最後登錄: 2013-5-22

論壇榮譽勳章論壇贊助勳章

3^#

發表於 2011-9-30 12:39 | 只看該作者

Dear GBKEE版大，

1.我試了您的方法，但卻出現 "陣列索引超出範圍 (錯誤 9)"，程式碼如下：
Sub 統計()
Dim Wb As Workbook
For Each Wb In Workbooks
   If Wb.Name <> "統計.xls" Then '排除 "統計.xls"
      Wb.Sheets("Sheet2").Copy After:=Workbooks("統計.xls").Sheets(2) '錯誤9
         ActiveSheet.Name = Replace(Wb.Name, ".xls", "")
   End If
Next
Workbooks("統計.xls").Activate
End Sub
2.我另外又加了路徑，但卻出現 "型態不符合 (錯誤 13)"，程式碼如下：
Sub 統計()
Dim MyBook, Wb As Workbook, MyPath As Long
Set MyBook = ThisWorkbook
MyPath = MyBook.Path & "\"                                     '型態不符
  With Workbooks.Open(MyPath & "*.xls")
   For Each Wb In Workbooks
      If Wb.Name <> "統計.xls" Then
         Wb.Sheets("Sheet2").Copy after:=MyBook.Sheets(Sheets.Count)
         ActiveSheet.Name = Replace(Wb.Name, ".xls", "")
      End If
   Next
End With
Workbooks("統計.xls").Activate
End Sub
3.我是要將不同檔名的檔案匯入一個excel檔內，再來作資料處理。

waterful.tw