返回列表 上一主題 發帖

[發問] vba開啟並抓取指定資料夾內關鍵字檔案&活頁名稱資料

[發問] vba開啟並抓取指定資料夾內關鍵字檔案&活頁名稱資料

擷取2.PNG
2018-2-6 22:44
擷取.PNG
2018-2-6 22:44

說明:
按下【按鈕1】時,自動開啟指定資料夾內檔案『list20180206135132.xls』 ,並將活頁名稱「list20180206135132」A:Z資料貼至此活頁A1,再將檔案『list20180206135132.xls』關閉

遇到問題:
檔案『list20180206135132.xls』除了 list 為固定字串,後面的日期時間數字均不固定,包含檔案內的活頁名稱也是一樣只有 list 為固定字串,後面的日期時間數字均不固定
因此巨集在寫的時候希望可以改為開啟指定關鍵字檔名『list』的檔案,例如list201802081532、list201803290915…以此類推,只要檔名有『list』關鍵字即符合條件,活頁名稱也是一樣

提醒:
指定資料夾內不只一個檔案,所以不能不指定檔名,否則有可能開到別的檔案了,以上求解~~~~~~~~~~


測試.rar (19.28 KB)
*宅女一枚無誤*

回復 1# msmplay

自動開啟指定資料夾內檔案『list*.xls』第一個工作表的 A:Z資料 複製到活頁[list報表]A欄,再將檔案『list*.xls』關閉


   
  1. Option Explicit
  2. Sub Ex()
  3.   Dim xDir As String, xPath As String, xWb As Workbook
  4.   xPath = ThisWorkbook.Path
  5.   xDir = Dir(xPath & "\list*.xls", vbDirectory)
  6.   Do While xDir <> ""
  7.     Set xWb = Workbooks.Open(xPath & "\" & xDir)
  8.     With ThisWorkbook.Sheets("list報表").Range("A1").End(xlDown)
  9.         If .Row = .Parent.Rows.Count Then
  10.             xWb.Sheets(1).UsedRange.Copy .Cells.End(xlUp)
  11.         Else
  12.             xWb.Sheets(1).UsedRange.Copy .Cells.Offset(1)
  13.         End If
  14.    
  15.   
  16.     End With
  17.     xWb.Close
  18.     xDir = Dir
  19.   Loop
  20. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 2# GBKEE


   G大非常感謝幫忙~~~~~測試已成功喔!!!再次感謝ㄟ
*宅女一枚無誤*

TOP

回復 2# GBKEE


   G大~~~~~不好意思,小妹好像遇到了一個超蠢的問題耶!!!就是如果同時有4個檔案要匯入,而且檔名都不一樣的時候該怎麼修改呢???例如:檔1『list*.xls』要匯入活頁「list報表」的A1
檔2『CCMOP*.xls』要匯入活頁「有資料」的B1
檔3『CCMOP_NAME*.xls』要匯入活頁「無資料」的B1
檔4『預約表單*.xls』要匯入活頁「預約表單」的A1


因為我發現我自己怎麼改好像都不行那~~~~~
*宅女一枚無誤*

TOP

本帖最後由 GBKEE 於 2018-2-15 07:55 編輯

回復 4# msmplay
  1. '檔1『list*.xls』要匯入活頁「list報表」的A1
  2. '檔2『CCMOP*.xls』要匯入活頁「有資料」的B1
  3. '檔3『CCMOP_NAME*.xls』要匯入活頁「無資料」的B1
  4. '檔4『預約表單*.xls』要匯入活頁「預約表單」的A1
  5. Option Explicit
  6. Sub Ex()
  7.     Dim xDir As String, xPath As String, xWb As Workbook
  8.     Dim Sh(), Dir_Ar(), xRng(), i As Integer
  9.     Dir_Ar = Array("list*.xls", "CCMOP*.xls", "CCMOP_NAME*.xls", "預約表單*.xls")
  10.     Sh = Array("list報表", "有資料", "無資料", "預約表單")
  11.     xRng = Arry("A1", "B1", "B1", "A1")
  12.     xPath = ThisWorkbook.Path
  13.     For i = 0 To UBound(Sh)
  14.         xDir = Dir(xPath & "\" & Dir_Ar(i), vbDirectory)
  15.         Do While xDir <> ""
  16.             If i = 1 And InStr(UCase(xDir), "CCMOP_NAME") Then GoTo xNext
  17.             Set xWb = Workbooks.Open(xPath & "\" & xDir)
  18.             With ThisWorkbook.Sheets(Sh(i)).Range(xRng(i)).End(xlDown)
  19.                 If .Row = .Parent.Rows.Count Then
  20.                     xWb.Sheets(1).UsedRange.Copy .Cells.End(xlUp)
  21.                 Else
  22.                     xWb.Sheets(1).UsedRange.Copy .Cells.Offset(1)
  23.                 End If
  24.             End With
  25.             xWb.Close
  26. xNext:
  27.             xDir = Dir
  28.         Loop
  29.     Next
  30. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 5# GBKEE


   G大好厲害ㄛ你!真是超級感謝你的熱血幫忙ㄛ
*宅女一枚無誤*

TOP

回復  msmplay
GBKEE 發表於 2018-2-11 08:33



    大師 有小筆誤 :第11列 Aeray 是Array 哦

TOP

回復 7# jeffrey628litw
粗心大意,感謝指出,
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 君子立恆志,小人恆立志。
返回列表 上一主題