Board logo

標題: [發問] 取得部分相同檔名之內容 [打印本頁]
作者: loyyee    時間: 2013-5-7 23:05     標題: 取得部分相同檔名之內容

請問我在"A1"儲存格輸入其他檔案前6碼檔名時，就可以取得該檔案內資料，
可否有函數或巨集可以達成。

EX:
輸入:34212A  取得 34121A-ACER-45678 檔案內資料
輸入:34185A  取得 34185A-SAMSUNG-1234567 檔案內資料

[attach]14916[/attach]
作者: stillfish00    時間: 2013-5-8 04:17

回復 1# loyyee
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim s
  3.     If Target.Address = "$A$1" Then
  4.         s = Dir(ThisWorkbook.Path & "\" & [A1] & "*")
  5.         If s <> "" Then
  6.             [A2] = Evaluate("SUM('" & ThisWorkbook.Path & "\[" & s & "]RR:BB'!$B$10)")
  7.         Else
  8.             MsgBox "File Not Found!"
  9.         End If
  10.     End If
  11. End Sub
複製代碼
作者: loyyee    時間: 2013-5-8 17:12

感謝stillfish00 回復，不過巨集好像不行用。
作者: stillfish00    時間: 2013-5-8 17:31

回復 3# loyyee
因為用 Worksheet_Change Event，所以要放在工作表而不是模組:

Alt + F11，專案視窗，展開 Microsoft Excel物件
Sheet1點兩下，貼上上面的 code
作者: loyyee    時間: 2013-5-8 18:03

感謝您，不過有點問題:
1."A1"儲存格=""時才會相加，有數值時就出現錯誤。
2.如果相對應檔案不開啟時，輸入A1儲存格:34121A可否達成
='D:\[34121A-ACER-45678.xls]RR'!$B$10+'D:\[34121A-ACER-45678.xls]BB'!$B$10

輸入:34185A  取得 34185A-SAMSUNG-1234567 檔案內資料
='D:\[34185A-SAMSUNG-1234567 .xls]RR'!$B$10+'D:\[34185A-SAMSUNG-1234567 .xls]BB'!$B$10
作者: stillfish00    時間: 2013-5-8 20:46

本帖最後由 stillfish00 於 2013-5-8 20:48 編輯

回復 5# loyyee
Evaluate有時候好像不聽使喚，
改這樣呢?  保留公式
然後計算是RR~BB各工作表的B10相加
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim s
  3.     If Target.Address = "$A$1" Then
  4.         s = Dir(ThisWorkbook.Path & "\" & [A1] & "*")
  5.         If s <> "" Then
  6.             [A2] = "=SUM('" & ThisWorkbook.Path & "\[" & s & "]RR:BB'!$B$10)"
  7.         Else
  8.             [A2]=""
  9.             MsgBox "File Not Found!"
  10.         End If
  11.     End If
  12. End Sub
複製代碼
作者: GBKEE    時間: 2013-5-8 21:01

本帖最後由 GBKEE 於 2013-5-8 21:31 編輯

回復 6# stillfish00
  1. Evaluate 方法
  2. 請參閱套用至範例特定將 Microsoft Excel 名稱轉換成物件或者值。
  3. expression.Evaluate (Name)
  4. expression      對於選擇性的 Application 物件，對於必選的 Chart 物件，DialogSheet 物件，和 Worksheet 物件。傳回 [套用於] 清單中的物件的運算式。
  5. Name     必選的 String。物件名稱，使用 Microsoft Excel 的命名轉換。

  7. 備註
  8. 下列幾類 Microsoft Excel 名稱可以使用此方法：

  10. A1 樣式的參照。可以 A1 樣式的記號列出對任意的單個儲存格的參照。所有的參照都當成絕對參照。
  11. 範圍。您可以使用範圍、交叉範圍和多重範圍，使用的運算子分別為冒號、空白及逗號。
  12. 已定義的名稱。您可以指定巨集語言中任何名稱。

  14. 外部參照。可以使用 ! 運算子參照另一活頁簿上的儲存格或已定義的名稱。例如，Evaluate("[BOOK1.XLS]Sheet1!A1")。

  16. PS: ***--外部參照。 [BOOK1.XLS] 須是開啟的 -***-'外部參照到 未開啟的檔案傳回錯誤

  18. 附註  使用方括號 (例如, A1:C5) 與用字串引數呼叫 Evaluate 方法是等效的。例如，下列運算式對是等價的。
複製代碼
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim s
  3.     If Target.Address = "$A$1" Then
  4.         s = Dir(ThisWorkbook.Path & "\" & [A1] & "*")
  5.         If s <> "" Then
  6.             Application.EnableEvents = False
  7.             
  8.             '[A2] 公式 1
  9.             [A2] = "='" & ThisWorkbook.Path & "\[" & s & "]RR'!$B$10 *2"
  10.             '[A2] = "='" & ThisWorkbook.Path & "\[" & s & "]RR'!$B$10+'" & ThisWorkbook.Path & "\[" & s & "]RR'!$B$10"
  11.             
  12.             '[A2] 公式 2
  13.             'Names.Add Name:="AAA", RefersTo:="='" & ThisWorkbook.Path & "\[" & s & "]RR'!$B$10"
  14.             '[A2] = "=AAA*2"             '"=AAA+AAA"
  15.             '[A4] = Evaluate("AAA")     '傳回錯誤值
  16.             [A2] = [A2].Value           '公式轉為數值
  17.             Application.EnableEvents = True
  18.         Else
  19.             MsgBox "File Not Found!"
  20.         End If
  21.     End If
  22. End Sub
複製代碼
作者: stillfish00    時間: 2013-5-9 00:49

6#修正如下，因A1空白時，s會傳回任意檔
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim s As String
  3.    
  4.     If Target.Address = "$A$1" Then
  5.         If [A1] = "" Then [A2] = "": Exit Sub       '避免Dir回傳任意檔案
  6.         
  7.         s = Dir(ThisWorkbook.Path & "\" & [A1] & "*")
  8.         
  9.         If s <> "" Then
  10.             [A2] = "=SUM('" & ThisWorkbook.Path & "\[" & s & "]RR:BB'!$B$10)"
  11.             [A2] = [A2].Value
  12.         Else
  13.             [A2] = ""
  14.             MsgBox "File Not Found!"
  15.         End If
  16.     End If
  17. End Sub
複製代碼
作者: stillfish00    時間: 2013-5-9 00:59

本帖最後由 stillfish00 於 2013-5-9 01:01 編輯

回復 7# GBKEE
PS: ***--外部參照。 [BOOK1.XLS] 須是開啟的 -***-'外部參照到 未開啟的檔案傳回錯誤

版大，我又試了一下
先使用下面的code去試，A2 會顯示 #REF!
然後把  [A3] = "=SUM('" & ThisWorkbook.Path & "\[" & s & "]RR:BB'!$B$10)"  的註解拿掉
再隨便多改幾次A1後，A2又會顯示正確值了
真是想不透阿..
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim s As String
  3.    
  4.     If Target.Address = "$A$1" Then
  5.         If [A1] = "" Then [A2] = "": Exit Sub       '避免Dir回傳任意檔案
  6.         
  7.         s = Dir(ThisWorkbook.Path & "\" & [A1] & "*")
  8.         
  9.         If s <> "" Then
  10.             [A2] = Evaluate("=SUM('" & ThisWorkbook.Path & "\[" & s & "]RR:BB'!$B$10)")
  11.             '[A3] = "=SUM('" & ThisWorkbook.Path & "\[" & s & "]RR:BB'!$B$10)"
  12.         Else
  13.             [A2] = ""
  14.             MsgBox "File Not Found!"
  15.         End If
  16.     End If
  17. End Sub
複製代碼
作者: loyyee    時間: 2013-5-9 17:17

謝謝二位解答，不過經計算後數值有點奇怪，研究中。



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)