- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 119
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-5-17
               
|
15#
發表於 2013-5-1 10:09
| 只看該作者
回復 14# PJChen
程式碼都有註解，請了解程式碼就能自行更改- Sub Ex()
- Dim A As Range
- fs = ThisWorkbook.Sheets("VBA").[A2] 'A2為檔名
- With Workbooks(fs)
- .Sheets("報表").UsedRange = .Sheets("報表").UsedRange.Value
- .Sheets("報表").Copy '把報表複製到新檔案
- .Close 0 '關閉a.xlsx
- End With
- Application.DisplayAlerts = False '關閉對話方塊
- ActiveWorkbook.SaveAs "D:\抽水機數據分析_值.xlsx" '將新檔儲存
- With Workbooks("抽水機數據分析_值.xlsx") '報表新檔案
- With .Sheets("報表")
- .UsedRange = .UsedRange.Value '去除公式
- .Range("A1").CurrentRegion.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(10, 11), _
- Replace:=True, PageBreaks:=False, SummaryBelowData:=True '已連續日期分組小計
- .[A:D].Delete '刪除A:D欄位
- If .[B3] = "" Then .Rows(3).Delete
- With .Range("F:F").SpecialCells(xlCellTypeFormulas)
- .Offset(, -1) = "計"
- For Each A In .Cells '畫框線
- A = Round(A, 3) '四捨五入小數點3位
- A.Offset(, 1) = Round(A.Offset(, 1), 3) '四捨五入小數點3位
- For i = 7 To 10
- A.Offset(, -1).Resize(, 3).Borders(i).Weight = xlThick '框線寬度
- A.Offset(, -1).Resize(, 3).Borders(i).ColorIndex = 3 '框線顏色
- Next
- Next
- End With
- For i = 1 To .Cells(.Rows.Count, "E").End(xlUp).CurrentRegion.Rows.Count '總計表格畫框線
- For j = 7 To 10
- With .Cells(.Rows.Count, "E").End(xlUp).CurrentRegion.Rows(i).Borders(j)
- .Weight = xlThick
- .ColorIndex = 3
- End With
- Next
- Next
- End With
- .Save
- End With
- Application.DisplayAlerts = True
- End Sub
|
|
發表於 2013-5-1 01:18
| 
