返回列表 上一主題 發帖

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

本帖最後由 Hsieh 於 2018-3-6 17:20 編輯

回復 10# msmplay
試試看
  1. Sub ex()
  2. Dim xlPath$
  3. xlPath = ThisWorkbook.Path
  4. Set fd = CreateObject("Scripting.Dictionary")
  5. fa = Array("list", "CCMOP_NAME", "CCMOP", "預約表單")
  6. sh = Array("list報表", "無資料", "無資料2", "有資料", "有資料2", "預約表單")
  7. an = Array(1, 1, 2, 1, 2, 4)
  8. For i = 0 To UBound(fa)
  9. f = Dir(xlPath & "\" & fa(i) & "*.xls")
  10. Do Until f = ""
  11. If fd.exists(f) = False Then
  12. fd(f) = f
  13.    With Workbooks.Open(xlPath & "\" & f)
  14.      If i = 0 Then
  15.         ar = Array(1)
  16.         ElseIf i = 1 Or i = 2 Then
  17.         ar = Array(1, 2)
  18.         Else
  19.         ar = Array(4)
  20.      End If
  21.      For j = 0 To UBound(ar)
  22.        With .Sheets(ar(j))
  23.        If k = 0 Or k = 5 Then Rng = "A1" Else Rng = "B1"
  24.           .Range("A1").CurrentRegion.Copy ThisWorkbook.Sheets(sh(k)).Range(Rng)
  25.        End With
  26.        k = k + 1
  27.      Next
  28.       .Close 0
  29.    End With
  30. End If
  31. f = Dir
  32. Loop
  33. Next
  34. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 11# Hsieh


    H大~~~~首先非常非常非常感謝你熱心幫忙喔~~~~~~~不過測試結果為:
檔1『list*.xls』的Sheets(1)要匯入活頁「list報表」的A1:成功匯入
檔2『CCMOPQ*.xls』的Sheets(1)跟Sheets(2)要匯入活頁「有資料」的B1跟活頁「有資料2」的B1:Sheets(1)成功匯入「有資料」的B1Sheets(2)未匯入但匯入成Sheets(1)到「有資料2」的B1
檔3『CCMOP_NAME*.xls』的Sheets(1)跟Sheets(2)要匯入活頁「無資料」的B1跟活頁「無資料2」的B1:Sheets(1)成功匯入「無資料」的B1Sheets(2)未匯入但匯入成Sheets(1)到「無資料2」的B1
檔4『預約表單*.xls』的Sheets(4)要匯入活頁「預約表單」的A1:未匯入

可以再請你幫忙看看嗎~~~~~~
*宅女一枚無誤*

TOP

回復 11# Hsieh


   H大~~~~測試成功了喔!!!非常感謝~~~~~~~
*宅女一枚無誤*

TOP

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