返回列表 上一主題 發帖

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

john711101

帖子
15 
主題
9 
精華
0 
積分
54 
點名
0  
作業系統
windows 7 
軟體版本
2010 
閱讀權限
20 
註冊時間
2015-2-13 
最後登錄
2024-3-1 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2019-12-17 10:03 | 只看該作者

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

我需要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
複製代碼
收藏 分享

john711101

帖子
15 
主題
9 
精華
0 
積分
54 
點名
0  
作業系統
windows 7 
軟體版本
2010 
閱讀權限
20 
註冊時間
2015-2-13 
最後登錄
2024-3-1 
5#
發表於 2019-12-19 10:52 | 只看該作者
回復 4# ikboy
謝謝指導
抱歉因該是我說的不夠詳細
我的資料夾如圖

未1名.png

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

TOP

ikboy

帖子
262 
主題
8 
精華
0 
積分
280 
點名
17  
作業系統
xp 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
HK 
註冊時間
2015-8-11 
最後登錄
2024-11-19 

2016猴年全勤獎章
4#
發表於 2019-12-18 16:39 | 只看該作者
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

john711101

帖子
15 
主題
9 
精華
0 
積分
54 
點名
0  
作業系統
windows 7 
軟體版本
2010 
閱讀權限
20 
註冊時間
2015-2-13 
最後登錄
2024-3-1 
3#
發表於 2019-12-18 16:05 | 只看該作者
回復 2# jcchiang

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

TOP

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
2#
發表於 2019-12-18 08:37 | 只看該作者
回復 1# john711101

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

TOP

        靜思自在 : 一個人不怕錯，就怕不改過，改過並不難。
返回列表 上一主題