麻辣家族討論版版 - Powered by Discuz! Board

Sub Ex()
Dim MyRng(1 To 2) As Range, Rng(1 To 2) As Range, i As Integer, R As Integer, C As Integer
Dim OpFile As String
With ThisWorkbook.Sheets("Sheet1")
Set MyRng(1) = .[B9:AR9] '輸入區
Set MyRng(2) = .[B13:AR15] '輸入區
End With
OpFile = Dir(ThisWorkbook.Path & "\*.xls") '尋找檔案 '檔案在同一目錄下
'OpFile = Dir("d:\test" & "\*.xls") '檔案不在同一目錄下
Do While OpFile <> "" '找到檔案
If OpFile <> "" And OpFile <> ThisWorkbook.Name Then
'With Workbooks.Open("d:\test\" & OpFile).Sheets("Sheet1") '檔案不在同一目錄下
With Workbooks.Open(ThisWorkbook.Path & "\" & OpFile).Sheets("Sheet1") '開啟檔案
Set Rng(1) = .[B9:AR9] '資料區
Set Rng(2) = .[B13:AR15] '資料區
For i = 1 To UBound(MyRng) '依序在輸入區
For C = 1 To MyRng(i).Columns.Count '輸入區的欄位
For R = 1 To MyRng(i).Rows.Count '輸入區的列位
MyRng(i).Cells(R, C) = MyRng(i).Cells(R, C) + Rng(i).Cells(R, C) '讀取紀錄
Next
Next
Next
.Parent.Close False '關閉檔案
'.Parent ->(???).Sheets("Sheet1")的父層->Workbooks(ThisWorkbook.Path & "\" & OpFile)
End With
End If
OpFile = Dir '往下一檔案
Loop
End Sub

複製代碼