返回列表 上一主題 發帖

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

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
1# 跳轉到 »
發表於 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
複製代碼

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 2013-5-8 17:31 | 顯示全部帖子
回復 3# loyyee
因為用 Worksheet_Change Event，所以要放在工作表而不是模組:

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

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
3#
發表於 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
複製代碼

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
4#
發表於 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
複製代碼

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
5#
發表於 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
複製代碼

TOP

        靜思自在 : 犯錯出懺悔心，才能清淨無煩惱。
返回列表 上一主題