[發問] 將多個EXCEL 匯到一個EXCEL的問題

帖子: 8
主題: 1
精華: 0
積分: 50
點名: 0
作業系統: windows 7
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2012-4-25
最後登錄: 2023-5-8

15^#

發表於 2012-4-26 21:56 | 只看該作者

原來是要這樣才能將檔案併在一起呀

konantw

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

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

14^#

發表於 2012-4-14 16:57 | 只看該作者

回復 13# yanto913

程式設計應盡量避免錯誤產生才是正道

Sub test()
Dim sht()
Application.ScreenUpdating = False '關閉螢幕更新
fd = ThisWorkbook.Path & "\" '檔案所在目錄
For Each a In [A1:A5]
fs = fd & a & ".xls"
fb = Dir(fs)
If fb <> "" Then
a.Offset(, 1) = "OK"
With Workbooks.Open(fd & fb)
Set sh = .Sheets(1)
ReDim Preserve sht(s) '記住所有工作表名稱
sht(s) = sh.Name
s = s + 1
sh.Copy after:=ThisWorkbook.Sheets(1) '複製工作表
.Close 0 '關閉檔案
End With
End If
Next
Sheets(sht).Move '移動所有複製的工作表到新檔案
Application.ScreenUpdating = True '恢復螢幕更新
End Sub

複製代碼

學海無涯_不恥下問

yanto913

帖子: 116
主題: 29
精華: 0
積分: 232
點名: 0
作業系統: winXp
軟體版本: office 2003
閱讀權限: 20
性別: 女
來自: 台灣台中市
註冊時間: 2010-9-6
最後登錄: 2023-7-11

13^#

發表於 2012-4-14 16:50 | 只看該作者

回復 9# Hsieh

謝謝Hsieh 版主

我的附檔內A1~A5分別為1~5數字，當A1儲存格的1有找到1.xls則B1顯示"OK"
但因我仍卡在的問題是用on error resume next會全部忽略錯誤，導致B1~B5全部顯示都"OK"

YOYO

LeafYeung

帖子: 7
主題: 1
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: 03
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2012-4-6
最後登錄: 2013-7-28

12^#

發表於 2012-4-14 15:21 | 只看該作者

回復 10# LeafYeung

明白了.....謝謝 Hsieh 的指導

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

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

11^#

發表於 2012-4-14 14:29 | 只看該作者

回復 10# LeafYeung
On Error 陳述式
一個「啟動的」錯誤處理程式是由 On Error 陳述式所打開的；一個「動作中」的錯誤處理程式是一個已啟動的錯誤處理程式正在處理錯誤。如果錯誤處理程式在動作中又發生了錯誤，(在錯誤發生和 Resume，Exit Sub，Exit Function，或 Exit Property 陳述式之間)，那麼現在此程序的錯誤處理程式將無法再處理此錯誤。
所以，要處理可能產生多次錯誤的程序，必須是Resume Next，而要繼續處理就必須清除當前錯誤物件
執行下面程序當可了解錯誤後處理狀態

Sub test1()
For i = 1 To 10
k = Int((2 - 0 + 1) * Rnd + 0)
On Error GoTo AAA '錯誤時跳至
B = i / k '製造錯誤
Next
AAA:
MsgBox "被除數等於=" & i & "除數等於=" & k
Err.Clear
Resume Next
End Sub

複製代碼

學海無涯_不恥下問

LeafYeung

帖子: 7
主題: 1
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: 03
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2012-4-6
最後登錄: 2013-7-28

10^#

發表於 2012-4-14 13:54 | 只看該作者

回復 9# Hsieh

Hsieh 版主
請問以下程序在執行第二次 on error goto 時為何會出現 error 呢??

Sub test1()
For i = 1 To 10
On Error GoTo AAA '錯誤時跳至
B = i / 0 '製造錯誤
AAA:
On Error GoTo 0
Next
End Sub

當 i=1時就可行,但當i=2時就 error
煩請教導~~謝謝

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

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

9^#

發表於 2012-4-14 12:35 | 只看該作者

回復 8# yanto913

看你A1:A5的檔名樣式為何?是否包含資料夾目錄或副檔名
不同資料有不同處理方式，以樓上的程式碼去加判斷式應該不是很難的

學海無涯_不恥下問

yanto913

帖子: 116
主題: 29
精華: 0
積分: 232
點名: 0
作業系統: winXp
軟體版本: office 2003
閱讀權限: 20
性別: 女
來自: 台灣台中市
註冊時間: 2010-9-6
最後登錄: 2023-7-11

8^#

發表於 2012-4-14 12:23 | 只看該作者

回復 7# Hsieh

謝謝Hsieh 版主

請問如果我只想要把sheets("all")中A1~A5為檔名去搜尋xls
而且搜尋到的在sheets("all")中B1~B5標示"OK"該如何做呢?

YOYO

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

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

7^#

發表於 2012-4-14 10:41 | 只看該作者

回復 1# yanto913

Sub test()
Dim sht()
Application.ScreenUpdating = False '關閉螢幕更新
fd = ThisWorkbook.Path & "\" '檔案所在目錄
fs = fd & "*.xls"
fb = Dir(fs)
Do Until fb = "" '所有xls檔案迴圈
If fb <> ThisWorkbook.Name Then
With Workbooks.Open(fd & fb)
Set sh = .Sheets(1)
ReDim Preserve sht(s) '記住所有工作表名稱
sht(s) = sh.Name
s = s + 1
sh.Copy after:=ThisWorkbook.Sheets(1) '複製工作表
.Close 0 '關閉檔案
End With
End If
fb = Dir
Loop
Sheets(sht).Move '移動所有複製的工作表到新檔案
Application.ScreenUpdating = True '恢復螢幕更新
End Su

複製代碼

學海無涯_不恥下問