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

john711101

我需要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

複製代碼

jcchiang

回復 1# john711101

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

john711101

回復 2# jcchiang

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

ikboy

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

複製代碼

john711101

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

下載 (11.69 KB)

2019-12-19 10:35

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