如何將多個檔案，相同格式的數值，透過VBA加總成一個檔案

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

1^# 跳轉到 »

發表於 2011-9-27 15:52 | 顯示全部帖子

回復 1# lai.k.h

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

複製代碼

靜思自在 : 小事不做、大事難成。