返回列表 上一主題 發帖

依當下執行時間，如何自動將指定工作表名稱修改成此格式"1018-上午"???

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2012-10-18 13:57 | 顯示全部帖子
回復 1# p6703
  1. Sub Ex()
  2.     ActiveSheet.Name = Format(Now(), "mmdd") & "-" & Mid(Format(Time(), "C"), 1, 2)
  3. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2012-10-18 16:48 | 顯示全部帖子
回復 4# p6703
試試看
  1. Option Explicit
  2. Sub EX()
  3.     Dim xlName As String, Sh As Worksheet, i As Integer
  4.     xlName = Format(Now(), "mmdd") & "-" & Mid(Format(Time(), "C"), 1, 2)
  5.     On Error GoTo R:
  6.     With Sheets.Add(, Sheets(Sheets.Count))
  7.         ActiveSheet.Name = xlName
  8.     End With
  9. R:
  10.     If Err.Number <> 0 Then
  11.         For Each Sh In Sheets
  12.             If InStr(Sh.Name, xlName) Then i = i + 1
  13.         Next
  14.         xlName = xlName & "(" & i & ")"
  15.         Err.Clear
  16.         Resume
  17.     End If
  18. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2012-10-19 10:40 | 顯示全部帖子
回復 6# p6703
所以要說明白的
  1. Option Explicit
  2. Sub 新訂單()
  3.     Dim xlName As String, Sh As Worksheet
  4.     Dim Msg As Boolean
  5.     xlName = Format(Now(), "mmdd") & "-" & Mid(Format(Time(), "C"), 1, 2)
  6.     For Each Sh In Sheets
  7.         If InStr(Sh.Name, xlName) Then Msg = True: Exit For
  8.     Next
  9.     If Msg = False Then   '沒比對到
  10.         Sheets.Add(, Sheets(Sheets.Count)).Name = xlName
  11.     Else
  12.         With Sh           '比對到
  13.             If Mid(.Name, 9) = "" Then   '尚未有()
  14.             .Name = .Name & "(1)"
  15.             Else                         '已有()
  16.                 .Name = xlName & "(" & Val(Mid(.Name, 9)) + 1 & ")"
  17.             End If
  18.         End With
  19.     End If
  20. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2012-10-19 20:34 | 顯示全部帖子
回復 8# p6703
再試試看
  1. Option Explicit
  2. Sub 新訂單()
  3.     Dim xlName As String, Sh As Worksheet
  4.     Dim xMsg As Integer
  5.     xlName = Format(Now(), "mmdd") & "-" & Mid(Format(Time(), "C"), 1, 2)
  6.     For Each Sh In Sheets
  7.         If InStr(Sh.Name, xlName) Then xMsg = xMsg + 1
  8.     Next
  9.     Sheets.Add(, Sheets(Sheets.Count)).Name = xlName & IIf(xMsg > 0, "(" & xMsg & ")", "")
  10. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2012-10-23 09:43 | 顯示全部帖子
回復 11# p6703
現在我已弄不清楚了,你執行一次後要的是什麼?
你說: 新訂單工作表--->日期+上(下)午工作表（工作表名稱變更，非新增工作表）
Q:活頁簿中:  日期+上(下)午工作表 是每天的日期都有一張嗎?
還是活頁簿中不管是日期為何,都只有 (當日日期) 一張 日期+上(下)午工作表 ?

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2012-10-23 10:30 | 顯示全部帖子
回復 13# p6703
是這樣嗎?                  
7# 程式碼
  1. If Msg = False Then   '沒比對到
  2.              MsgBox "找不到 " & xlName        
  3.            '註解 Sheets.Add(, Sheets(Sheets.Count)).Name = xlName
  4.        Else
複製代碼

TOP

        靜思自在 : 人要知福、惜福、再造福。
返回列表 上一主題