12
返回列表 上一主題 發帖

[發問] 以A2儲存格為檔名,做成小計報表

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-4-26 17:49 | 只看該作者

[發問] 以A2儲存格為檔名,做成小計報表

有些步驟無法用錄製方式,請大大們幫忙!!
需要執行巨集的報表可能有數個,所以我希望將檔案名稱直接標示在A2.

巨集執行的步驟為:
1- a.xlsx已事先開啟,copy(新增) 報表.sheet後,將它變成沒有任何公式,存檔為:抽水機數據分析_值.xlsx,(為了上傳檔案不要太大,所以事先將a.xlsx變成只有值)
2- 關閉原a.xlsx並且不要存檔.
3- 刪除 抽水機數據分析_值  A:C (運作次數(全) /1啟動 /2啟動 )
2- 以"連續日期 "執行分組小計",加總的欄位是"用電度數" and "使用時間(分)".
3- 刪除A欄:連續日期
4- 點選小計選項2    ActiveSheet.Outline.ShowLevels RowLevels:=2 '小計後選#2
5- 希望完成後的報表,我另放在"完成後的報表.sheet"中.
6. 報表.sheet的資料每次都不相同,當然有可能增加筆數,用錄製的無法因應每次不同筆數的作業.

抽水機數據分析報表.zip (30.09 KB)
收藏 分享

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 2013-4-26 20:49 | 只看該作者
本帖最後由 stillfish00 於 2013-4-26 20:52 編輯

6不太懂 , 你試看看還有什麼問題
  1. Sub paper2()
  2.     Workbooks(ThisWorkbook.Sheets("VBA").[A2].Value).Sheets("報表").Range("D:K").Copy   '複製D欄到K欄
  3.    
  4.     With Workbooks.Add  '新增一空白活頁簿
  5.         With .Sheets(1)
  6.             .Name = "報表"
  7.             .[A1].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False  '貼上值
  8.             .[A1].PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False  '貼上來源格式
  9.             
  10.             '小計
  11.             .[A2].Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7, 8), _
  12.                     Replace:=True, PageBreaks:=False, SummaryBelowData:=True
  13.             
  14.             .[A:A].Delete Shift:=xlToLeft       '小計後刪除A欄
  15.             .Outline.ShowLevels RowLevels:=2    '小計後選#2
  16.         End With
  17.         .SaveAs "D:\抽水機數據分析報表\抽水機數據分析_值.xlsx"  '儲存檔案
  18.         .Close
  19.     End With
  20.    
  21.     '關閉檔案
  22.     Workbooks(ThisWorkbook.Sheets("VBA").[A2].Value).Close False
  23.     ThisWorkbook.Close False
  24. End Sub
複製代碼
回復 1# PJChen

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
3#
發表於 2013-4-26 23:08 | 只看該作者
回復 2# stillfish00

您好,

巨集雖可執行,但有以下不符,請再幫忙查看.
1.  原a.xlsx的報表.sheet為一個格式已設定好的報表,希望可以將原檔copy成新的,較方便作業.
2.  新的檔  抽水機數據分析_值.xlsx,無法將公式變成值,我測試了下,還是有公式. 如: 抽水機數據分析_值.zip      抽水機數據分析_值.zip (9.21 KB)
3.  我想要完成後的檔案如: 完成後的報表.zip       完成後的報表.zip (9.9 KB)

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
4#
發表於 2013-4-29 10:07 | 只看該作者
  1. Sub paper2()
  2.     With Workbooks(ThisWorkbook.Sheets("VBA").[A2].Value).Sheets("報表")
  3.         .UsedRange.Value = .UsedRange.Value    '改為值
  4.         .Range("A:C").Delete Shift:=xlToLeft   '刪除A:C
  5.         
  6.         '小計
  7.         .[A2].Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7, 8), _
  8.                 Replace:=True, PageBreaks:=False, SummaryBelowData:=True
  9.         .[A:A].Delete Shift:=xlToLeft       '小計後刪除A欄
  10.         .Outline.ShowLevels RowLevels:=2    '小計後選#2
  11.         .SaveAs "D:\抽水機數據分析報表\抽水機數據分析_值.xlsx"  '儲存檔案
  12.         .Parent.Close False
  13.     End With
  14.    
  15.     '關閉報表程式
  16.     ThisWorkbook.Close False
  17. End Sub
複製代碼
回復 3# PJChen

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
5#
發表於 2013-4-29 22:21 | 只看該作者
回復 4# stillfish00

您好,

第2次的修改已經可以將另存的 抽水機數據分析_值.xlsx檔案內容改為值,但它依無法完全像 "完成後的報表.zip" 同格式(包含框線),因為這部份無法用錄製的(因為報表資料會變化),如果有人知道怎麼寫後續的程式的話,是否可以幫幫忙?

我想讓小計完成後 點選小計2        .Outline.ShowLevels RowLevels:=2, 將可見儲存格劃紅色粗框線(詳見: "完成後的報表.zip" )

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
277  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-12-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2013-4-29 23:30 | 只看該作者
本帖最後由 Hsieh 於 2013-4-29 23:33 編輯

回復 5# PJChen
  1. Sub Ex()
  2. Workbooks("a.xlsx").Sheets("報表").Copy '把報表複製到新檔案
  3. Workbooks("a.xlsx").Close 0 '關閉a.xlsx
  4. Application.DisplayAlerts = False '關閉對話方塊
  5. ActiveWorkbook.SaveAs "D:\抽水機數據分析_值.xlsx" '將新檔儲存
  6. With Workbooks("抽水機數據分析_值.xlsx") '報表新檔案
  7. With .Sheets("報表")
  8. .UsedRange = .UsedRange.Value '去除公式
  9. .Range("A1").CurrentRegion.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(10, 11), _
  10.         Replace:=True, PageBreaks:=False, SummaryBelowData:=True '已連續日期分組小計
  11. .[A:D].Delete '刪除A:D欄位
  12. If .[B3] = "" Then .Rows(3).Delete
  13. With .Range("F:F").SpecialCells(xlCellTypeFormulas)
  14. .Offset(, -1) = "計"
  15. For Each A In .Cells '畫框線
  16.    For i = 7 To 10
  17.        A.Offset(, -1).Resize(, 3).Borders(i).Weight = xlMedium
  18.        A.Offset(, -1).Resize(, 3).Borders(i).ColorIndex = 3
  19.    Next
  20. Next
  21. End With
  22. .UsedRange = .UsedRange.Value '去除公式
  23. End With
  24. .Save
  25. End With
  26. Application.DisplayAlerts = True
  27. End Sub
複製代碼
學海無涯_不恥下問

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
7#
發表於 2013-4-30 22:02 | 只看該作者
回復 6# Hsieh

大大,

感謝你再次的幫忙.
出現了點小問題,因為每個報表要區分各種不同的抽水機,所有會有各式各樣的檔名,我想延用最初的概念,將檔名設在以下的A2儲存格中,
1)  請問在你寫的程式中,我要怎麼將以下的句子套進程式中?
    With Workbooks(ThisWorkbook.Sheets("VBA").[A2].Value).Sheets("報表")
2) 我想將線改成最粗的線,是否改這句?應該怎麼改?     For Each A In .Cells '畫框線

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
277  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-12-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
8#
發表於 2013-4-30 22:43 | 只看該作者
本帖最後由 Hsieh 於 2013-5-1 00:23 編輯

回復 7# PJChen
  1. Sub Ex()
  2. fs = ThisWorkbook.Sheets("VBA").[A2] 'A2為檔名
  3. Workbooks(fs).Sheets("報表").Copy '把報表複製到新檔案
  4. Workbooks(fs).Close 0 '關閉a.xlsx
  5. Application.DisplayAlerts = False '關閉對話方塊
  6. ActiveWorkbook.SaveAs "D:\抽水機數據分析_值.xlsx" '將新檔儲存
  7. With Workbooks("抽水機數據分析_值.xlsx") '報表新檔案
  8. With .Sheets("報表")
  9. .UsedRange = .UsedRange.Value '去除公式
  10. .Range("A1").CurrentRegion.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(10, 11), _
  11.         Replace:=True, PageBreaks:=False, SummaryBelowData:=True '已連續日期分組小計
  12. .[A:D].Delete '刪除A:D欄位
  13. If .[B3] = "" Then .Rows(3).Delete
  14. With .Range("F:F").SpecialCells(xlCellTypeFormulas)
  15. .Offset(, -1) = "計"
  16. For Each A In .Cells '畫框線
  17.    For i = 7 To 10
  18.        A.Offset(, -1).Resize(, 3).Borders(i).Weight = xlThick '框線寬度
  19.        A.Offset(, -1).Resize(, 3).Borders(i).ColorIndex = 3 '框線顏色
  20.    Next
  21. Next
  22. End With
  23. .UsedRange = .UsedRange.Value '去除公式
  24. End With
  25. .Save
  26. End With
  27. Application.DisplayAlerts = True
  28. End Sub
複製代碼
學海無涯_不恥下問

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
9#
發表於 2013-5-1 00:12 | 只看該作者
回復 8# Hsieh

大大,
1)  跑到這行就中止了,因為A2的儲存格可以用任意檔名,檔名不是"a.xlsx"時,它就無法繼續了,改成以下請問差別在哪兒?
Workbooks("a.xlsx").Close 0 '關閉a.xlsx....改為Workbooks(fs).Close 0 '關閉a.xlsx  >>ok
                                                                            ....改為Workbooks("fs").Close 0 '關閉a.xlsx  >>不行
2) 若小計&總計 欄位,改為小數後2位四捨五入,請問要在哪行更改?加上什麼程式?

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
10#
發表於 2013-5-1 00:33 | 只看該作者
回復 8# Hsieh

不好意思,除了前面二項,又發現另一個問題.
3) 原來的報表.sheet是有公式及連結的,為了方便上傳,所以公式差不多都去除了,在存檔前要先把公式變成值(否則全都錯誤值),是否加在這句之後?
可是它說是"錯誤的引用",我改怎麼改?
  1. Workbooks(fs).Sheets("報表").Copy '把報表複製到新檔案
  2. .UsedRange = .UsedRange.Value '去除公式
複製代碼

TOP

        靜思自在 : 滴水成河。粒米成蘿，勿輕己靈，勿以善小而不為。
12
返回列表 上一主題