如何將下面的程式碼改成只匯在同一個資料表

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

3^#

發表於 2012-7-8 10:01 | 只看該作者

回復 2# chen_cook

抱歉...已修改，這樣應該可以了

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

4^#

發表於 2012-7-9 00:02 | 只看該作者

上面的檔案是合併後會分成很多個分頁，我希望他可以不要分開

hugh0620

　暱稱: VBA向前衝

高中生 Rank: 3 Rank: 3

帖子: 550
主題: 55
精華: 0
積分: 614
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-4-23

5^#

發表於 2012-7-9 17:30 | 只看該作者

本帖最後由 hugh0620 於 2012-7-9 17:31 編輯

回復 4# qwern

  試試下面的寫法~ 依你上載的資料還撰寫~ 將資料夾中的EXCEL檔匯在同一個sheet中~
  A3="檔案名稱"
  B3=欄位A
  A3&B3是要有欄位名稱唷

Application.Calculation = xlCalculationManual
Dim Ar()
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = 0 Then Exit Sub ' 若是沒有選取資料夾路徑，就跳出程序
Sheet1.Rows("4:1048576").ClearContents
fd = .SelectedItems(1)
If .ButtonName = "確定" Then
fs = Dir(fd & "\*.xls")
Do Until fs = ""
fds = fd & "\" & fs
With Workbooks.Open(fds)
A = .Sheets(1).Range("A65536").End(xlUp).Row
BN = .Sheets(1).Name
.Sheets(1).Range("A1:CW" & A).Copy Sheet1.Range("B1048576").End(xlUp).Offset(1, 0)
.Close 0
End With
C1 = Sheet1.Range("A1048576").End(xlUp).Offset(1, 0).Row
C2 = Sheet1.Range("B1048576").End(xlUp).Row
Sheet1.Range("A" & C1 & ":A" & C2) = BN
fs = Dir
Loop
End If
End With
Application.Calculation = xlCalculationAutomatic

複製代碼

學習才能提升自己

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

6^#

發表於 2012-7-9 17:43 | 只看該作者

回復 4# qwern
檔案都放在同一個資料夾內

Sub ex()
fs = Dir(ThisWorkbook.Path & "\*.xls*")
Do Until fs = ""
If fs <> ThisWorkbook.Name Then
With Workbooks.Open(ThisWorkbook.Path & "\" & fs)
.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Close 0
End With
End If
fs = Dir
Loop
End Sub

複製代碼

學海無涯_不恥下問

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

7^#

發表於 2012-7-10 00:16 | 只看該作者

Hsieh 超級版主感謝，好像成功了
VBA向前衝感謝這方法我還在測試中

hugh0620

　暱稱: VBA向前衝

高中生 Rank: 3 Rank: 3

帖子: 550
主題: 55
精華: 0
積分: 614
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-4-23

8^#

發表於 2012-7-10 09:23 | 只看該作者

回復 7# qwern

Hsieh 大大的寫法是直接將資料夾中所有的excel資料匯在一起~
我的寫法也是之前各大大教的~ 所以看起來不會差異太大~
在匯整資料時~ 是幫你考量到~ 將每一個檔案匯入時~ 添加上個檔案的名稱~
這樣會方便使用者在資料有疑問時~ 能夠比較快速找個是哪一個檔案的資料~ 哪邊發生問題

當然~ 這也是要看你自己的需求~ 是不是有需要~
利用 Hsieh 大大的模式可延伸自己需要的結果~

學習才能提升自己

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

9^#

發表於 2012-7-15 02:16 | 只看該作者

恩恩我發現Hsieh大大的方法在填入第517個excel檔時會有問題，他說複製格式不同是否要貼上