- 帖子
- 2807
- 主題
- 10
- 精華
- 0
- 積分
- 2863
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-5-5
|
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 |
|
發表於 2015-11-22 10:50
| 