Sub readedit()
'####### 預設檔案擺放的位置,可修改以下變數
sPath = ActiveWorkbook.Path & "\aReport\"
'######################################################
'清除本頁所有資料
Cells.Clear
'讀取本 Workbook 名稱
wName = ActiveWorkbook.Name
'讀取本 WorkSheet 名稱
sName = ActiveSheet.Name
'開始抄入 31 日的檔案
With Workbooks(wName).Worksheets(sName)
For aa = 1 To 31
'決定本頁的續寫範圍
LastRow = .Range("A65536").End(xlUp).Row
If LastRow = 1 Then
'如果是第 1 日,則寫在第一列
LastRow = 1
Else
'不是第 1 日,則須寫在緊隨資料後的空白列
LastRow = LastRow + 1
End If
'取得檔案名稱中的"日期"
sDay = Right("0" & aa, 2)
'合成要開啟的檔案全名
aRs = "rs-201012" & sDay & ".xls"
'以唯讀開啟每日報數檔
Workbooks.Open Filename:=sPath & aRs, ReadOnly:=True
'如果是第 1 日,則連「標題列」抄入
If aa = 1 Then
'簡化了的抄入方法 (1)
Sheets("Report").Range("A1").CurrentRegion.Copy .Cells(LastRow, 1)
Else
'不果是第 1 日,則 Resize 省略「標題列」
Set aRng = Sheets("Table").Range("A1").CurrentRegion
Set aRng = aRng.Offset(1, 0).Resize(aRng.Rows.Count - 1)
'簡化了的抄入方法 (2)
aRng.Copy .Cells(LastRow, 1)
End If
'關閉已開的每日檔
ActiveWorkbook.Close
'開下一日之報數檔
Next aa
End With
'簡化了的寫法:假設只有本頁開啟
With Range("A1").CurrentRegion
'原來的報數檔都是「文字」,故轉為值
.Cells = .Cells.Value
'設定字型
.Font.Name = "Arial"
'設定字型大小
.Font.Size = 8
' .Font.Bold = True
' .Font.ColorIndex = 3
End With
End Sub
沒有留言:
張貼留言