- 帖子
- 549
- 主題
- 152
- 精華
- 0
- 積分
- 691
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- OFFICE 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-8-10
- 最後登錄
- 2022-9-7
 
|
回復 1# rbktwi
 test.rar (29.5 KB)
- Sub 巨集1()
- Application.ScreenUpdating = False '關閉螢幕
- ' myfloder="您的檔案路徑包含最後一個要\"
- w1 = ActiveWorkbook.Name
- '若是想要找到這個EXCEL檔案的所在目錄就使用
- Dim WrdArray() As String
- myfloder = ""
- WrdArray() = Split(ThisWorkbook.FullName, "\")
- For i = 0 To UBound(WrdArray) - 1
- myfloder = myfloder & "\" & WrdArray(i)
- Next i
- myfloder = Mid(myfloder, 2, Len(myfloder) - 1) & "\"
-
- '找出所有檔案名稱
- FILE1 = Dir(myfloder)
- Do While FILE1 <> ""
- ar = ar & "," & FILE1 '(沒指定哪種檔案的EXCEL)
- FILE1 = Dir '取得下一個檔名
- Loop
- ar = Split(Mid(ar, 2, 100000), ",") '拆開第一個,
- '跑每個EXCEL檔
- For Each e In ar
- If e <> w1 Then '不執行自己本的檔案
- Workbooks.Open (myfloder & e)
- Cells(1, 1) = "123" 'A1輸入值(沒指定SHEET)
- ActiveWindow.Close saveChanges:=True '關閉且儲存
- End If
- Next
- Application.ScreenUpdating = True '恢復螢幕
- End Sub
|
|
發表於 2015-1-6 20:32
| 