oak0723-1

中學生 Rank: 2

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2017-3-2 13:49 | 只看該作者

[發問] 如何指定將不同檔案夾的csv檔中特定範圍的資料copy到特定檔案中

如何

小弟有一個檔案夾名稱000(如附件)
該檔案夾000中有名稱分別為01.02.03等3個檔案夾
而於檔案夾01及02中分別有數個csv檔
另於檔案夾03中也有數個xls檔(如附件03-1)
想在檔案夾03中的xls中指定路徑和檔案名稱將資料copy到指定儲存格(如附件03檔案夾中之03-1檔案說明)

圖片-問題說明.jpg (302.6 KB)

000.rar (315 KB)

樓主熱帖

oak0723-1

中學生 Rank: 2

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

9^#

發表於 2017-3-12 22:28 | 只看該作者

感謝GBKEE老師願意熱心幫小弟解答的問題
因小弟最近比較忙加上有點感冒..所以精神較差
所以比較晚回復..真是抱歉....
剛測試過..確實是小弟所需要的
非常感謝...
再次感恩...

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

8^#

發表於 2017-3-9 08:57 | 只看該作者

回復 7# oak0723-1

Option Explicit
Sub Ex()
Dim Rng(1 To 2) As Range, Sh As Worksheet, i As Integer, E As Range
'**設定讀取多檔案的資料位置
Set Rng(1) = ActiveWorkbook.ActiveSheet.Range("C7") '**視窗作用中的活頁簿的作用中工作頁的"C7"
'Set Rng(1) = WorkbookS("???.xls").Sheets("???").Range("C7") '**指定的活頁簿的???工作頁的"C7"
'Set Rng(1) = ThisWorkbook.Sheets("???").Range("C7") '**程式碼所在的活頁簿的???工作頁的"C7"
'**設定 F6等黃色區域輸入儲存格編號的位置
Set Rng(2) = Rng(1).Parent.Range("F6")
Set Rng(2) = Range(Rng(2), Rng(2).End(xlToRight)) '延伸到最右邊的資料
'**************************************
Do While Rng(1) <> "" 'Rng有資料
If Dir(Rng(1) & "\" & Rng(1).Cells(1, 2) & ".xls") = "" Then GoTo NoXls_Or_NoSheet:
With Workbooks.Open(Rng(1) & "\" & Rng(1).Cells(1, 2) & ".xls") '**開啟多檔案 (XLS或 CSV)
On Error GoTo NoXls_Or_NoSheet:
Set Sh = .Sheets(Rng(1).Cells(1, 3).Text) '**設定多檔案的工作頁
Err.Clear
i = 4
For Each E In Rng(2)
Rng(1).Cells(1, i) = Sh.Range(E) '讀取黃色區域指定的資料
i = i + 1
Next
.Close '關閉檔案
End With
Set Rng(1) = Rng(1).Offset(1) '下一個檔案資料
Loop
'*********************************************
Exit Sub '程式執行正常下離開這程式
NoXls_Or_NoSheet:
MsgBox Rng(1) & " \ " & Rng(1).Cells(1, 2) & " \ " & Rng(1).Cells(1, 3) & vbLf & "找不到" & IIf(Err, Rng(1).Cells(1, 3).Text, "")
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

oak0723-1

中學生 Rank: 2

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

7^#

發表於 2017-3-8 21:50 | 只看該作者

感謝GBKEE老師願意熱心繼續關心小弟的問題
小弟這個問題已用其他方式解決
不知是否能幫小弟另一個問題
如何讀取多個檔案中同一個儲存格資料http://forum.twbts.com/thread-19358-1-1.html

TOP

oak0723-1

中學生 Rank: 2

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

6^#

發表於 2017-3-5 14:55 | 只看該作者

感謝GBKEE老師願意熱心繼續回復小弟的問題
可能我問題問得不好
因為小弟只是舉例
所以檔名都簡化替代
但實務上小弟的資料夾很多
每個檔案中的csv檔案也很多
當然每個檔名也都不同
因為每個csv檔內都有2組資料須cpy集中在同一個xls檔內
所以希望有熱心網友能幫幫小弟的忙
謝謝

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

5^#

發表於 2017-3-5 05:43 | 只看該作者

回復 3# oak0723-1
2#的程式碼是依你提出的條件所寫,你要改變條件當然會不行的

Set Wb = Workbooks("03.XLS") '指定的XLS擋
Set Wb = ActiveWindow '作用中的XLS擋
Set Wb = ThisWorkbook '程式碼所在的XLS擋
Set Wb = Windows(2) '第二個XLS擋

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

oak0723-1

中學生 Rank: 2

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

4^#

發表於 2017-3-4 23:47 | 只看該作者

感謝GBKEE老師的賜教
只不過小弟發現2個問題
1.若輸入資料夾和檔名若非原預設01,01-1就無法執行
2.若輸入資料夾和檔名維持原預設01,01-1更改欄位起點和終點儲存格(例如輸入d5和f5)所copy過來的資料卻仍是原預設d1,f1
3.若檔案03更改名稱就無法執行出現錯誤

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

3^#

發表於 2017-3-4 14:31 | 只看該作者

回復 1# oak0723-1

試試看

Option Explicit
Dim Wb As Workbook
Sub Ex()
Dim xFile As String, Sh As Worksheet, i As Integer, Rng As Range
Set Wb = Workbooks("03.XLS") '指定的XLS擋
xFile = ThisFile
If InStr(xFile, "CSV") = False Then MsgBox xFile: Exit Sub
Set Sh = Wb.Sheets("SHEET1") '指定的XLS擋的工作頁
With Workbooks.Open(xFile)
For i = 1 To 2
Set Rng = .Sheets(1).Range(Sh.Cells(1 + 1, "E") & ":" & Sh.Cells(1 + i, "F")) '指定的位置
Set Rng = .Sheets(1).Range(Rng, Rng.End(xlDown)) ''指定的位置往下至資料的終點
With Sh.Cells(Rows.Count, "a").End(xlUp).Offset(1) 'A欄最底列往上到有資料的儲存閣的下一列
.Resize(Rng.Rows.Count, Rng.Columns.Count) = Rng.Value
End With
Next
.Close
End With
End Sub
Function ThisFile() As String
With Wb '**指定的XLS擋
ThisFile = Mid(.Path, 1, InStrRev(.Path, "\")) '**指定的XLS擋的上層資料夾
With .Sheets("Sheet1")
ThisFile = ThisFile & .Range("b2") & "\" & .Range("c2") & ".CSV" '上層資料夾+子資料\的CSV檔案完整路徑
'**** 檢查CSV的檔案是否存在
If Dir(ThisFile) = "" Or Application.CountA(.Range("E2:F3")) <> 4 Then ThisFile = "請檢查" & vbLf & Join(Application.Transpose(Application.Transpose([B1:F1])), ",")
End With
End With
End Function