返回列表 上一主題 發帖

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

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

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

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

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

回復 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
複製代碼

TOP

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

TOP

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

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

TOP

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

TOP

本帖最後由 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
複製代碼

TOP

本帖最後由 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 的命名轉換。

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

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

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

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

  13. 附註  使用方括號 (例如, 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

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
複製代碼

TOP

本帖最後由 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
複製代碼

TOP

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

TOP

        靜思自在 : 人要知福、惜福、再造福。
返回列表 上一主題