將不同檔案內資料貼在同一檔案

請問如何將指定資料夾C:\temp\內所有CSV 的檔案續個開啟,
然後將資料貼在同一個新的工作表內, 但每個CSV的檔案行數不固定

例如A.CSV 共有3行, 會貼在新工作表1-3行
跟住開B.CSV 共有10行, 會貼在第4-13行
請指教

樓主熱帖

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

4^#

發表於 2012-2-25 15:13 | 只看該作者

回復 3# enoch
[  ]..看這裡

Rng.Parent  點用呢?
程式已 DIM  Rng As Range  .Parent ->   Range的父層(上一層物件: 所在的工作表 )

MsgBox .Sheets(1).UsedRange.Rows.Count  ' CSV檔的內容的行數

所有 CSV檔的內容複製完畢後
MsgBox  Rng.Row 可顯示複製所有 CSV檔的內容的行數

TOP

enoch

中學生 Rank: 2

帖子: 176
主題: 98
精華: 0
積分: 279
點名: 0
作業系統: window 7
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2011-2-17
最後登錄: 2020-4-8

3^#

發表於 2012-2-25 11:59 | 只看該作者

本帖最後由 enoch 於 2012-2-25 12:03 編輯

謝謝GBKEE
但有部份程式唔明白, 想請問:
Sheets(1).[a1] 與 Sheets(1).range("a1") 相同嗎

Set Sh = Rng.Parent 點用呢?

同埋想最後顯示總共複製了多少行資料

及在此程式以外, 如何檢查工作表內總共用了多少行

煩請再指教

TOP

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

2^#

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

回復 1# enoch
試試看

Option Explicit
Sub Ex()
Dim xlPath As String, Rng As Range, xF As String, Sh As Worksheet
xlPath = "C:\temp\" '指定資料夾
xF = Dir(xlPath & "*.CSV")
'Dir 函數傳回一個 String ，用以表示合乎條件、檔案屬性、磁碟標記的一個檔案名稱、或目錄、檔案夾名稱。
If xF = "" Then MsgBox xlPath & " 沒有CSV 檔案": Exit Sub
Application.ScreenUpdating = False
Set Rng = Workbooks.Add(1).Sheets(1).[a1] '新開檔案第1個工作表的[A1]的儲存格
Do
With Workbooks.Open(xlPath & xF) '開啟 Dir 傳回的 String(在此為檔案名稱)
If Rng.Row > 1 Then Set Rng = Rng.Offset(1) '儲存格不是[A1]下移一列
.Sheets(1).UsedRange.Copy Rng 'CSV檔的內容複製到 Rng
Set Rng = Rng.End(xlDown) '複製後 Rng往下移到資料底端
.Close SaveChanges:=False '關閉CSV檔不存檔
End With
xF = Dir '繼續尋找 CSV檔
Loop Until xF = "" '離開Do 迴圈的條件是繼續尋找不到 CSV檔
Application.ScreenUpdating = True
MsgBox xlPath & " CSV 檔案複製完成"
Set Sh = Rng.Parent
Sh.Parent.SaveAs xlPath & "TEST.XLS" '''''存檔
End Sub

複製代碼

TOP