標題:
依當下執行時間,如何自動將指定工作表名稱修改成此格式"1018-上午"???
[打印本頁]
作者:
p6703
時間:
2012-10-18 11:53
標題:
依當下執行時間,如何自動將指定工作表名稱修改成此格式"1018-上午"???
原工作表名稱如想依當天日期上下午各儲存如"1018-上午",或"1018-下午"名稱時,請問如何可以巨集自動執行達成???
作者:
kimbal
時間:
2012-10-18 13:28
回復
1#
p6703
工作表是執行後新加上?
第一段是同時加上 "上午","下午" 兩份.
第二段是按當運行時時間加上
Sub ampm()
Worksheets.Add
ActiveSheet.Name = Format(Now(), "MM-DD") & "-上午"
Worksheets.Add
ActiveSheet.Name = Format(Now(), "MM-DD") & "-下午"
End Sub
Sub bytime()
Worksheets.Add
ActiveSheet.Name = Format(Now(), "MM-DD") & "-" & IIf(Hour(Now()) >= 12, "下午", "上午")
End Sub
複製代碼
作者:
GBKEE
時間:
2012-10-18 13:57
回復
1#
p6703
Sub Ex()
ActiveSheet.Name = Format(Now(), "mmdd") & "-" & Mid(Format(Time(), "C"), 1, 2)
End Sub
複製代碼
作者:
p6703
時間:
2012-10-18 15:30
感謝二位版主的指導,小弟執行已可符合需求,但又有一延伸問題請教
因原執行時已產生一個1018-下午的工作表,當再次執行時即秀出錯誤(原工作表已有該名稱)
是否可將再次執行產生的工作表名稱依序增加格式為:1018-下午(2),1018-下午(3)....
再次感謝版主的教導,謝謝...^^
作者:
GBKEE
時間:
2012-10-18 16:48
回復
4#
p6703
試試看
Option Explicit
Sub EX()
Dim xlName As String, Sh As Worksheet, i As Integer
xlName = Format(Now(), "mmdd") & "-" & Mid(Format(Time(), "C"), 1, 2)
On Error GoTo R:
With Sheets.Add(, Sheets(Sheets.Count))
ActiveSheet.Name = xlName
End With
R:
If Err.Number <> 0 Then
For Each Sh In Sheets
If InStr(Sh.Name, xlName) Then i = i + 1
Next
xlName = xlName & "(" & i & ")"
Err.Clear
Resume
End If
End Sub
複製代碼
作者:
p6703
時間:
2012-10-19 08:36
感謝GBKEE 版主,修改的確可如小弟告知的依序將同時段的工作表自動序號增加
但可能有點誤會小弟的意思了,小弟再說明一下
我指定的工作表是以其他的巨集執行產生的,可能就類似一個"新訂單"工作表,希望執行現請教的巨集後,即可將該工作表名稱自動變更成1018-下午形式,但當天可能又會再重新跑一次,又再產生一次新訂單工作表,如再按巨集執行時,名稱即變成1018-下午(1)(現執行巨集時是原工作表仍存在)
作者:
GBKEE
時間:
2012-10-19 10:40
回復
6#
p6703
所以要說明白的
Option Explicit
Sub 新訂單()
Dim xlName As String, Sh As Worksheet
Dim Msg As Boolean
xlName = Format(Now(), "mmdd") & "-" & Mid(Format(Time(), "C"), 1, 2)
For Each Sh In Sheets
If InStr(Sh.Name, xlName) Then Msg = True: Exit For
Next
If Msg = False Then '沒比對到
Sheets.Add(, Sheets(Sheets.Count)).Name = xlName
Else
With Sh '比對到
If Mid(.Name, 9) = "" Then '尚未有()
.Name = .Name & "(1)"
Else '已有()
.Name = xlName & "(" & Val(Mid(.Name, 9)) + 1 & ")"
End If
End With
End If
End Sub
複製代碼
作者:
p6703
時間:
2012-10-19 17:35
感謝GBKEE 版主立即的回覆,但小弟表達實在不佳,又讓GBKEE版主誤會
我想要的是當第一次執行巨集時,新訂單工作表--->1018-下午
當天可能會再有一次新工單工作表,當再次執行時,原1018-下午的工作表仍在,增加了新工作表1018-下午(2)
以此推類,也就是如果我當天執行三次巨集,就會產生三個工作表
==>1018-下午,1018-下午(2),1018-下午(3)
作者:
GBKEE
時間:
2012-10-19 20:34
回復
8#
p6703
再試試看
Option Explicit
Sub 新訂單()
Dim xlName As String, Sh As Worksheet
Dim xMsg As Integer
xlName = Format(Now(), "mmdd") & "-" & Mid(Format(Time(), "C"), 1, 2)
For Each Sh In Sheets
If InStr(Sh.Name, xlName) Then xMsg = xMsg + 1
Next
Sheets.Add(, Sheets(Sheets.Count)).Name = xlName & IIf(xMsg > 0, "(" & xMsg & ")", "")
End Sub
複製代碼
作者:
p6703
時間:
2012-10-19 23:30
感謝GBKEE版主可以了^^..不過小弟在家測試時跑出的格式竟然是1019-23(-->此變成時間),我在公司跑的時候都是上下午的..待週一再到公司試試^^再次說聲謝謝啦^^
作者:
p6703
時間:
2012-10-23 09:07
GBKEE版主,這二天執行發現有點問題,按此巨集執行,雖然可產生日期+上下午(序號)工作表,但該工作表中無任何資料,而且每日新訂單工作表仍在,小弟原以為是自己將程式碼加入關係造成,但後單獨只以版主提供的程式碼執行時,仍是此情況,請GBKEE版主再協助確認,謝謝
首次執行巨集:
新訂單工作表--->日期+上(下)午工作表(工作表名稱變更,非新增工作表)
當天再次執行巨集(當天可能會再捉一次新訂單工作表):
新訂單工作表--->日期+上(下)午(序號)工作表(工作表名稱變更,非新增工作表)
作者:
GBKEE
時間:
2012-10-23 09:43
回復
11#
p6703
現在我已弄不清楚了,你執行一次後要的是什麼?
你說: 新訂單工作表--->日期+上(下)午工作表
(工作表名稱變更,非新增工作表)
Q:活頁簿中: 日期+上(下)午工作表 是每天的日期都有一張嗎?
還是活頁簿中不管是日期為何,都只有 (
當日日期
) 一張 日期+上(下)午工作表 ?
作者:
p6703
時間:
2012-10-23 10:17
GBKEE版主,容小弟再解釋
一般一天會上下午各去捉取一次新訂單
上午捉取的新訂單工作表(此我是又另外用巨集去捉取的),執行巨集後,變成1023-上午(此時原新訂單工作表已變更此名稱)
但有時上午會捉取不止一次,當第二次捉取新訂單工作表時,執行巨集時,應變成了1023-上午(1),以此類推.....
作者:
GBKEE
時間:
2012-10-23 10:30
回復
13#
p6703
是這樣嗎?
7# 程式碼
If Msg = False Then '沒比對到
MsgBox "找不到 " & xlName
'註解 Sheets.Add(, Sheets(Sheets.Count)).Name = xlName
Else
複製代碼
作者:
p6703
時間:
2012-10-23 11:14
GBKEE 版主,小弟按原4#提供的程式巨集稍做修改,可符小弟的需求,在次再次感謝GBKEE 版主,謝謝....(原巨集應是新增工作表,但小弟需求的是將原工作表變更名稱,以便之後再新增"每日新訂單"工作表時不致錯誤)
Option Explicit
Sub 已核對的訂單可轉成日期名稱()
Dim xlName As String, Sh As Worksheet, i As Integer
xlName = Format(Now(), "mmdd") & "-" & Mid(Format(Time(), "C"), 1, 2)
On Error GoTo R:
Sheets("每日新訂單").Select
ActiveSheet.Name = xlName
R:
If Err.Number <> 0 Then
For Each Sh In Sheets
If InStr(Sh.Name, xlName) Then i = i + 1
Next
xlName = xlName & "(" & i & ")"
Err.Clear
Resume
End If
End Sub
複製代碼
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)