返回列表 上一主題 發帖

[發問] 請問各位大神如何簡化這個

[發問] 請問各位大神如何簡化這個

我需要B6格子內容去尋找對應的檔案開啟使用
目前程式碼如下,因太多種類平板使用會負荷不了,
謝謝
  1. Dim myFileName As String
  2. myFileName = Range("B6")
  3. '300
  4. If Range("B6") = "CJ" Then
  5.   myFileName = ThisWorkbook.Path & "\paper\300\XZU600\CJ\CJ.xlsm"
  6.   Workbooks.Open Filename:=myFileName, UpdateLinks:=True
  7. End If
  8. If Range("B6") = "CK" Then
  9.   myFileName = ThisWorkbook.Path & "\paper\300\XZU600\CK\CK.xlsm"
  10.   Workbooks.Open Filename:=myFileName, UpdateLinks:=True
  11. End If
  12. If Range("B6") = "CL" Then
  13.   myFileName = ThisWorkbook.Path & "\paper\300\XZU600\CL\CL.xlsm"
  14.   Workbooks.Open Filename:=myFileName, UpdateLinks:=True
  15. End If
  16. If Range("B6") = "CM" Then
  17.   myFileName = ThisWorkbook.Path & "\paper\300\XZU600\CM\CM.xlsm"
  18.   Workbooks.Open Filename:=myFileName, UpdateLinks:=True
  19. End If
  20. If Range("B6") = "CN" Then
  21.   myFileName = ThisWorkbook.Path & "\paper\300\XZU600\CN\CN.xlsm"
  22.   Workbooks.Open Filename:=myFileName, UpdateLinks:=True
  23. End If
  24. If Range("B6") = "CP" Then
  25.   myFileName = ThisWorkbook.Path & "\paper\300\XZU630\CP\CP.xlsm"
  26.   Workbooks.Open Filename:=myFileName, UpdateLinks:=True
  27. End If
  28. If Range("B6") = "CQ" Then
  29.   myFileName = ThisWorkbook.Path & "\paper\300\XZU640\CQ\CQ.xlsm"
  30.   Workbooks.Open Filename:=myFileName, UpdateLinks:=True
  31. End If
  32. If Range("B6") = "CR" Then
  33.   myFileName = ThisWorkbook.Path & "\paper\300\XZU640\CR\CR.xlsm"
  34.   Workbooks.Open Filename:=myFileName, UpdateLinks:=True
  35. End If
  36. If Range("B6") = "CS" Then
  37.   myFileName = ThisWorkbook.Path & "\paper\300\XZU640\CS\CS.xlsm"
  38.   Workbooks.Open Filename:=myFileName, UpdateLinks:=True
  39. End If
複製代碼

回復 1# john711101

直接將欄位值套入myFileName內,就不用做判斷
myFileName = ThisWorkbook.Path & "\paper\300\XZU600\" & Range("B6") & "\" & Range("B6") & ".xlsm"

TOP

回復 2# jcchiang

謝謝J大指導
可是我的資料夾路徑不只一個
:L :L

TOP

2# 已經OK了, 以下衹是防止一下。
  1. Sub zz()
  2. Dim myFileName As String, s$
  3. s = "JKLMNPQRS"
  4. For i = 1 To Len(s)
  5.     If [B6] = "C" & Mid(s, i, 1) Then
  6.         s = "C" & Mid(s, i, 1)
  7.         Workbooks.Open ThisWorkbook.Path & "\paper\300\XZU600\" & s & "\" & s & ".xlsm", 1
  8.     End If
  9. Next
  10. End Sub
複製代碼

TOP

回復 4# ikboy
謝謝指導
抱歉因該是我說的不夠詳細
我的資料夾如圖

未1名.png
2019-12-19 10:35


    目前是已單一的去判斷抓取不過檔案太多會導致平板電腦負荷不了
有更好的 方式去開啟我需要的檔案再請指導
謝謝

TOP

        靜思自在 : 自己害自己,莫過於亂發脾氣。
返回列表 上一主題