返回列表 上一主題 發帖

[發問] 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

        靜思自在 : 甘願做、歡喜受。
返回列表 上一主題