返回列表 上一主題 發帖

[發問] 如何能一鍵複製並新增多頁工作表?

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
1# 跳轉到 »
發表於 2015-11-22 10:50 | 顯示全部帖子
Sub 新增工作表()
Dim X, j%, k%, SN, SH As Worksheet
Do
　　X = Application.InputBox("請輸入日期，如：2015/6/6 或 2015-6-5")
　　If X & "" = "False" Then Exit Sub
　　If IsDate(X) Then Exit Do
　　MsgBox "日期錯誤或未輸入，請重新輸入∼∼"
Loop
　
Application.DisplayAlerts = False
For j = 0 To 8
For k = 0 To 1
　　SN = Format(DateValue(X) + j * 4 + k, "yyyy-m-d")　'工作表名稱
　　On Error Resume Next
　　　　Set SH = Nothing: Set SH = Sheets(SN)　'檢查工作表是否存在
　　On Error GoTo 0
　　If SH Is Nothing Then　'若工作表不存在，複製一個重命名
　　　Sheets("原始檔").Copy after:=Sheets(Sheets.Count)
　　　ActiveSheet.Name = SN
　　End If
Next k
Next j
Sheets("複製新增工作表").Select
End Sub

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub 刪除工作表()
Dim SH As Worksheet
Application.DisplayAlerts = False
For Each SH In Sheets
　　If IsDate(SH.Name) Then SH.Delete
Next
End Sub

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
2#
發表於 2015-12-7 10:04 | 顯示全部帖子
回復 6# RCRG


If MsgBox("確認要刪除工作表嗎？", 4 + 32 + 256) = vbNo Then Exit Sub

＜參數一＞
0只顯示 OK 按鈕。
1顯示 OK 及 Cancel 按鈕。
2顯示 Abort、 Retry 及 Ignore 按鈕。
3顯示 Yes、No 及 Cancel 按鈕。
4顯示 Yes 及 No 按鈕。
5顯示 Retry 及 Cancel 按鈕。
＜參數二＞
16顯示 Critical Message 圖示。
32顯示 Warning Query 圖示。
48顯示 Warning Message 圖示。
64顯示 Information Message 圖示。
＜參數三＞
0第一個按鈕是預設值。
256第二個按鈕 是預設值。
512第三個按鈕是預設值。
768第四個按鈕是預設值。

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言，就如鑽石般珍貴；但對愚人來說，卻像是一把泥土，一點價值也沒有。
返回列表 上一主題