12
返回列表 上一主題 發帖

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

hsiaohsien

帖子
9 
主題
3 
精華
0 
積分
17 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
10 
註冊時間
2011-8-13 
最後登錄
2017-4-21 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-9-19 20:42 | 只看該作者

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

這是我錄下的巨集，每月有30天的檔案，我想在全部開啟的情形下，使用這樣的巨集將特定的工作表分別複製到合併.xls成為單一檔案，有30個工作表中
Sub Macro1()
'
' Macro1 Macro
' hsiaohsien 在 2011/9/19 錄製的巨集
'

'
    Windows("0919.xls").Activate
    Sheets("統計").Select
    Sheets("統計").Copy After:=Workbooks("合併.xls").Sheets(2)
    Sheets("統計").Select
    Sheets("統計").Name = "0919" '<---------工作表名稱命名以工作簿檔名
End Sub

Sub Macro2()
'
' Macro1 Macro
' hsiaohsien 在 2011/9/19 錄製的巨集
'

'
    Windows("0918.xls").Activate
    Sheets("統計").Select
    Sheets("統計").Copy After:=Workbooks("合併.xls").Sheets(3)
    Sheets("統計").Select
    Sheets("統計").Name = "0918" '<---------工作表名稱命名以工作簿檔名
End Sub
收藏 分享

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2011-9-20 06:32 | 只看該作者
回復 1# hsiaohsien
  1. Sub Ex()
  2.     Dim Wb As Workbook
  3.     For Each Wb In Workbooks
  4.         If Wb.Name <> "合併.xls" Then   '排除 "合併.xls"
  5.             Wb.Sheets("統計").Copy After:=Workbooks("合併.xls").Sheets(2)
  6.             ActiveSheet.Name = Replace(Wb.Name, ".xls", "")
  7.         End If
  8.     Next
  9.     Workbooks("合併.xls").Activate
  10. End Sub
複製代碼

TOP

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

TOP

Hsieh

帖子
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 | 只看該作者
  1. Sub ex()
  2. Dim MyPath As String, fs As String, MySht As Worksheet
  3. MyPath = ThisWorkbook.Path & "\"
  4. fs = Dir(MyPath & "*.xls")
  5. Do Until fs = ""
  6. If fs <> ThisWorkbook.Name Then
  7.    With Workbooks.Open(fs)
  8.       Set MySht = .Sheets(2) '要複製的工作表
  9.       MySht.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  10.       ActiveSheet.Name = Replace(fs, ".xls", "")
  11.       .Close
  12.     End With
  13. End If
  14.     fs = Dir
  15. Loop
  16. End Sub
複製代碼
回復 3# waterful.tw
學海無涯_不恥下問

TOP

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

TOP

waterful.tw

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

論壇榮譽勳章論壇贊助勳章
6#
發表於 2011-10-1 09:29 | 只看該作者
sorry回復到一半，等我用Hsieh版大的方法試試，有問題 再來麻煩囉~
waterful.tw

TOP

GBKEE

帖子
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 鍵盤上的字元與符號

TOP

waterful.tw

帖子
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

TOP

GBKEE

帖子
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 開啟時會依 如圖設立目前的目錄或檔案夾

TOP

waterful.tw

帖子
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

TOP

        靜思自在 : 忘功不忘過，忘怨不忘恩。
12
返回列表 上一主題