12
返回列表 上一主題 發帖

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

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 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章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 

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

您好,

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

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

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 

論壇榮譽勳章論壇贊助勳章
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 
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

        靜思自在 : 能幹不幹，不如苦幹實幹。
12
返回列表 上一主題