- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 16
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2024-11-14
|
2#
發表於 2020-12-11 23:55
| 只看該作者
大家好，我第一次發帖，如果有什麼不對的請見諒
因為每月都要上交月結報表，不想再剪剪貼貼，所以在嘗試用 ...
lovenice831 發表於 2020-12-11 15:23 
我把 Module2 刪掉,
並把所有的程式都集中在Module1了 :- Public iI% ' 整個檔案內都可共用的變數或物件使用Public宣告於此,
- Public lRows&
- Public wsTar As Worksheet, wsSou(1 To 2) As Worksheet ' 重複性作業利用物件陣列與迴圈完成
- Sub Auto_Open() ' 開啟活頁簿時會自動執行, 可放置會共用需先初始化的指令
- Set wsTar = Worksheets("月結") ' 設定工作表物件變數
- Set wsSou(1) = Worksheets("工作表1")
- Set wsSou(2) = Worksheets("工作表2")
- End Sub
- Sub 月結_Click()
- With wsTar
- lRows = .Cells(Rows.Count, 1).End(xlUp).Row ' 從下往上找到最底下一列的列號
- If lRows < 3 Then lRows = 3 ' 最小為3, 避免刪掉標題
- .Range(.[A3], .Cells(lRows, 3)).Clear ' 清除上次產生的資料, 以便產生新資料
- End With
-
- For iI = 1 To 2 ' 對兩個工作表逐個取出需要的資料做處理
- With wsSou(iI)
- .Select ' 底下作用儲存格移到A欄最新資料列前,需先將工作表Select
- .[A3].AutoFilter Field:=2, Criteria1:="台灣"
- .Range(.[A3], .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 3)).Copy wsTar.Cells(Rows.Count, 1).End(xlUp).Offset(1)
- ' 拷貝需要的資料, 貼到月結工作表的資料最新列
- .[A3].AutoFilter Field:=2
- .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1).Offset(1).Select ' 作用儲存格移到A欄最新資料列-A欄從下往上算最底下一列的下方那格
- End With
- Next
- wsTar.Select ' 顯示月結工作表
- End Sub
- Sub test_()
- Dim Vsha
- Dim wsNew As Worksheet, wsTemp As Worksheet
-
- With Workbooks.Add
- Set wsTemp = .ActiveSheet
- wsTar.Copy before:=.Worksheets(1)
- Set wsNew = .ActiveSheet
- wsTemp.Delete
- Set wsTemp = Nothing
- With wsNew
- .name = .[11]
- For Each Vsha In .Shapes
- Vsha.Delete
- Next
- .Parent.SaveAs ThisWorkbook.Path & Application.PathSeparator & .name
- End With
- .Close False
- End With
- End Sub
 test save&clear-a.zip (22.04 KB)
|
|
發表於 2020-12-12 12:37
| 
