[發問] 取得部分相同檔名之內容

loyyee

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

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

部分相同檔名.rar (3.9 KB)

下載次數: 13

2013-5-7 23:03

stillfish00

回復 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

感謝stillfish00 回復，不過巨集好像不行用。

stillfish00

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

Alt + F11，專案視窗，展開 Microsoft Excel物件
Sheet1點兩下，貼上上面的 code

loyyee

感謝您，不過有點問題:
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

回復 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

回復 6# stillfish00

1. Evaluate 方法
   
2. 請參閱套用至範例特定將 Microsoft Excel 名稱轉換成物件或者值。
   
3. expression.Evaluate (Name)
   
4. expression      對於選擇性的 Application 物件，對於必選的 Chart 物件，DialogSheet 物件，和 Worksheet 物件。傳回 [套用於] 清單中的物件的運算式。
   
5. Name     必選的 String。物件名稱，使用 Microsoft Excel 的命名轉換。
   
6. 
   
7. 備註
   
8. 下列幾類 Microsoft Excel 名稱可以使用此方法：
   
9. 
   
10. A1 樣式的參照。可以 A1 樣式的記號列出對任意的單個儲存格的參照。所有的參照都當成絕對參照。
    
11. 範圍。您可以使用範圍、交叉範圍和多重範圍，使用的運算子分別為冒號、空白及逗號。
    
12. 已定義的名稱。您可以指定巨集語言中任何名稱。
    
13. 
    
14. 外部參照。可以使用 ! 運算子參照另一活頁簿上的儲存格或已定義的名稱。例如，Evaluate("[BOOK1.XLS]Sheet1!A1")。
    
15. 
    
16. PS: ***--外部參照。 [BOOK1.XLS] 須是開啟的 -***-'外部參照到 未開啟的檔案傳回錯誤
    
17. 
    
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

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

回復 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

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