帖子: 42
主題: 9
精華: 0
積分: 64
點名: 0
作業系統: WINDOW7
軟體版本: OFFICE2003
閱讀權限: 20
性別: 男
註冊時間: 2011-9-3
最後登錄: 2013-6-10

論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2013-5-7 23:05 | 只看該作者

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

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

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

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

樓主熱帖

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

2^#

發表於 2013-5-8 04:17 | 只看該作者

回復 1# loyyee

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s
If Target.Address = "$A$1" Then
s = Dir(ThisWorkbook.Path & "\" & [A1] & "*")
If s <> "" Then
[A2] = Evaluate("SUM('" & ThisWorkbook.Path & "\[" & s & "]RR:BB'!$B$10)")
Else
MsgBox "File Not Found!"
End If
End If
End Sub

複製代碼

TOP

loyyee

中學生 Rank: 2

帖子: 42
主題: 9
精華: 0
積分: 64
點名: 0
作業系統: WINDOW7
軟體版本: OFFICE2003
閱讀權限: 20
性別: 男
註冊時間: 2011-9-3
最後登錄: 2013-6-10

論壇榮譽勳章論壇贊助勳章

3^#

發表於 2013-5-8 17:12 | 只看該作者

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

TOP

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

4^#

發表於 2013-5-8 17:31 | 只看該作者

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

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

TOP

loyyee

中學生 Rank: 2

帖子: 42
主題: 9
精華: 0
積分: 64
點名: 0
作業系統: WINDOW7
軟體版本: OFFICE2003
閱讀權限: 20
性別: 男
註冊時間: 2011-9-3
最後登錄: 2013-6-10

論壇榮譽勳章論壇贊助勳章

5^#

發表於 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

TOP

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

6^#

發表於 2013-5-8 20:46 | 只看該作者

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

回復 5# loyyee
Evaluate有時候好像不聽使喚，
改這樣呢? 保留公式
然後計算是RR~BB各工作表的B10相加

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s
If Target.Address = "$A$1" Then
s = Dir(ThisWorkbook.Path & "\" & [A1] & "*")
If s <> "" Then
[A2] = "=SUM('" & ThisWorkbook.Path & "\[" & s & "]RR:BB'!$B$10)"
Else
[A2]=""
MsgBox "File Not Found!"
End If
End If
End Sub

複製代碼

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

7^#

發表於 2013-5-8 21:01 | 只看該作者

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

回復 6# stillfish00

Evaluate 方法
請參閱套用至範例特定將 Microsoft Excel 名稱轉換成物件或者值。
expression.Evaluate (Name)
expression 對於選擇性的 Application 物件，對於必選的 Chart 物件，DialogSheet 物件，和 Worksheet 物件。傳回 [套用於] 清單中的物件的運算式。
Name 必選的 String。物件名稱，使用 Microsoft Excel 的命名轉換。
備註
下列幾類 Microsoft Excel 名稱可以使用此方法：
A1 樣式的參照。可以 A1 樣式的記號列出對任意的單個儲存格的參照。所有的參照都當成絕對參照。
範圍。您可以使用範圍、交叉範圍和多重範圍，使用的運算子分別為冒號、空白及逗號。
已定義的名稱。您可以指定巨集語言中任何名稱。
外部參照。可以使用 ! 運算子參照另一活頁簿上的儲存格或已定義的名稱。例如，Evaluate("[BOOK1.XLS]Sheet1!A1")。
PS: ***--外部參照。 [BOOK1.XLS] 須是開啟的 -***-'外部參照到未開啟的檔案傳回錯誤
附註使用方括號 (例如, A1:C5) 與用字串引數呼叫 Evaluate 方法是等效的。例如，下列運算式對是等價的。

複製代碼

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s
If Target.Address = "$A$1" Then
s = Dir(ThisWorkbook.Path & "\" & [A1] & "*")
If s <> "" Then
Application.EnableEvents = False
'[A2] 公式 1
[A2] = "='" & ThisWorkbook.Path & "\[" & s & "]RR'!$B$10 *2"
'[A2] = "='" & ThisWorkbook.Path & "\[" & s & "]RR'!$B$10+'" & ThisWorkbook.Path & "\[" & s & "]RR'!$B$10"
'[A2] 公式 2
'Names.Add Name:="AAA", RefersTo:="='" & ThisWorkbook.Path & "\[" & s & "]RR'!$B$10"
'[A2] = "=AAA*2" '"=AAA+AAA"
'[A4] = Evaluate("AAA") '傳回錯誤值
[A2] = [A2].Value '公式轉為數值
Application.EnableEvents = True
Else
MsgBox "File Not Found!"
End If
End If
End Sub