[發問] 自動抓取指定資料夾所有檔案資料

msmplay

下載 (2.21 KB)

2017-6-23 22:15

下載 (4.58 KB)

2017-6-23 22:15

下載 (25.25 KB)

2017-6-23 22:25

請教一下網大們，如何在「資料導入」excel檔內按下【資料導入】按鈕後，自動抓取『測試』資料夾裡的所有檔案資料到「資料導入」excel檔。


問題如下：
1.『測試』資料夾裡的所有檔案名稱，除了開頭「TEST」是固定外，後面的日期、編號每天都會不一樣，所以非固定檔名。
2.『測試』資料夾裡的檔案非固定3個，有時只會有1個檔案，有時只有2個，但最多就3個。
3. 每個檔案除了標題不需抓取外，第二列以下所有資料均需抓取至「資料導入」檔對應欄，但3個檔案資料沒有分先後上下、哪個先哪個後，只要逐一抓取每個檔案資料並持續向下推疊即可。
例如:
只有1個檔案時，將該檔第二列以下資料抓取至「資料導入」檔第二列以下貼上。
有2個檔案時，先抓取第1個檔第二列以下資料，再抓取第2個檔第二列以下資料至「資料導入」檔第X列以下貼上。（X列為第1個檔最後一筆資料下一空白列）
有3個檔案時，先抓取第1個檔第二列以下資料，再抓取第2個檔第二列以下資料，再抓取第3個檔第二列以下資料至「資料導入」檔第X列以下貼上。（X列為第2個檔最後一筆資料下一空白列）




以上~~~~~~因為網路上一直找不到相關的VBA寫法，所以希望大師們可以熱心幫忙

測試.rar (10.41 KB)

下載次數: 11

2017-6-23 23:17

idnoidno

1. Option Explicit
   
2. Sub test12()
   
3.     Dim p As String
   
4.     Dim f As String
   
5.     Dim ws As Worksheet
   
6.     Dim wb As Workbook
   
7.     Dim r As Range
   
8.      
   
9.     p = "D:\TEMPWS\"  'CVS檔案的資料夾
   
10.      
    
11.     f = Dir(p & "*.csv")
    
12.     If f = "" Then Exit Sub
    
13.     Set ws = Workbooks.Open(p & f).Sheets(1)
    
14.      
    
15.     f = Dir()
    
16.     Do While f <> ""
    
17.         Set wb = Workbooks.Open(p & f)
    
18.         Set r = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    
19.         wb.Sheets(1).Cells(1).CurrentRegion.Offset(1).Copy Destination:=r
    
20.         wb.Close
    
21.         f = Dir()
    
22.     Loop     
    
23.     Application.Goto ws.Cells(1)     
    
24. End Sub

複製代碼

msmplay

回復 2# idnoidno


    i大~~~~~~你好厲害喔!!!!!!!!!真的是非常非常非常感謝你熱心幫忙喔~~~~~~~

idnoidno

別客氣，只是剛好有答案可以給你參考，幫到忙是我的福氣啦

msmplay

回復 4# idnoidno

i大~~~~上次非常感謝你的熱心幫忙，不過小妹又有新的問題想問問看有沒解，可以也請你再幫我看看嗎？跟你上次幫我解的有關，只是變成導入資料時希望直接導入原執行檔，然後........多了一堆希望自動執行的問題

下載 (41.36 KB)

2017-7-8 14:18

下載 (40.28 KB)

2017-7-8 14:18

下載 (57.1 KB)

2017-7-8 14:18

下載 (70.12 KB)

2017-7-8 14:18

下載 (51.42 KB)

2017-7-8 14:18

資料導入.rar (13.65 KB)

下載次數: 3

2017-7-8 14:18