返回列表 上一主題 發帖

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

msmplay

帖子
218 
主題
73 
精華
0 
積分
290 
點名
0  
作業系統
WIN10 
軟體版本
Office2010 
閱讀權限
20 
性別
女 
註冊時間
2014-5-19 
最後登錄
2022-11-29 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2017-6-23 23:27 | 只看該作者

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

1.PNG 2.PNG

請教一下網大們，如何在「資料導入」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)
收藏 分享
*宅女一枚無誤*

msmplay

帖子
218 
主題
73 
精華
0 
積分
290 
點名
0  
作業系統
WIN10 
軟體版本
Office2010 
閱讀權限
20 
性別
女 
註冊時間
2014-5-19 
最後登錄
2022-11-29 
5#
發表於 2017-7-8 14:21 | 只看該作者
回復 4# idnoidno

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




資料導入.rar (13.65 KB)
*宅女一枚無誤*

TOP

idnoidno

帖子
52 
主題
12 
精華
0 
積分
63 
點名
0  
作業系統
window 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-8-15 
最後登錄
2023-3-24 
4#
發表於 2017-6-26 14:39 | 只看該作者
別客氣，只是剛好有答案可以給你參考，幫到忙是我的福氣啦

TOP

msmplay

帖子
218 
主題
73 
精華
0 
積分
290 
點名
0  
作業系統
WIN10 
軟體版本
Office2010 
閱讀權限
20 
性別
女 
註冊時間
2014-5-19 
最後登錄
2022-11-29 
3#
發表於 2017-6-25 21:49 | 只看該作者
回復 2# idnoidno


    i大~~~~~~你好厲害喔!!!!!!!!!真的是非常非常非常感謝你熱心幫忙喔~~~~~~~
*宅女一枚無誤*

TOP

idnoidno

帖子
52 
主題
12 
精華
0 
積分
63 
點名
0  
作業系統
window 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-8-15 
最後登錄
2023-3-24 
2#
發表於 2017-6-25 20:39 | 只看該作者
  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
複製代碼

TOP

        靜思自在 : 是非當教育，讚美作警惕。
返回列表 上一主題