返回列表下一主題上一主題發帖

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

qwern

小學生 Rank: 1

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

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2012-7-8 03:16 | 只看該作者

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

本帖最後由 qwern 於 2012-7-8 10:01 編輯

主要要做的內容是，約有2000多的相同格式的excel檔案，要匯入同一個excel裡面，
但是又不想要他每次匯入時都分別匯入成一個新的資料表，
想要他重上一個貼點的最下面繼續將下將一個資料往下貼下去。
之前有有看過另外一個是貼進來為不同分頁的，但是我怎麼改他都無法只單純在一個分頁裡面，所以想要請問這個問題。

以下附件為合併巨集跟要匯入的資料但不知道怎麼把那個合併的巨集改成只匯入成一個工作表，匯入後，他還是會看有幾個檔案就分成幾個工作表
而且還有一個小疑問每個檔案內資料的比數不同，他會不會少抓到之類的?

javascript:;

合併後只要在同一個sheet.rar (564.34 KB)

合併後只要在同一個sheet

qwern

小學生 Rank: 1

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

9^#

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

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

TOP

hugh0620

　暱稱: VBA向前衝

高中生 Rank: 3 Rank: 3

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

8^#

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

回復 7# qwern

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

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

學習才能提升自己

TOP

qwern

小學生 Rank: 1

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

7^#

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

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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

複製代碼

學海無涯_不恥下問

TOP

hugh0620

　暱稱: VBA向前衝

高中生 Rank: 3 Rank: 3

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

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