2011年1月4日 星期二

VBA: 簡化了抄入方法

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

沒有留言: