如果工作表名稱已存在，Excel重命名工作表

Question

如何重命名工作表並在名稱末尾添加數字（如果該名稱已存在）。

我正在使用此代碼，但如果名稱已存在，則需要在工作表名稱末尾添加一個數字。

VBA_BlankBidSheet.Copy After:=ActiveSheet 
ActiveSheet.Name = "New Name" 

Answer 1

下面的代碼通過ThisWorkbook所有工作表和檢查循環是否已經有以「新名」的名稱的紙，如果這樣做，在最後增加了許多。

Sub RenameSheet() 

Dim Sht     As Worksheet 
Dim NewSht    As Worksheet 
Dim VBA_BlankBidSheet As Worksheet 
Dim newShtName   As String 

' modify to your sheet's name 
Set VBA_BlankBidSheet = Sheets("Sheet1") 

VBA_BlankBidSheet.Copy After:=ActiveSheet  
Set NewSht = ActiveSheet 

' you can change it to your needs, or add an InputBox to select the Sheet's name 
newShtName = "New Name" 

For Each Sht In ThisWorkbook.Sheets 
    If Sht.Name = "New Name" Then 
     newShtName = "New Name" & "_" & ThisWorkbook.Sheets.Count    
    End If 
Next Sht 

NewSht.Name = newShtName 

End Sub 

Answer 2

上一個新的工作簿會生成這些表名稱試驗程序： Sheet1_1，Sheet2_1和ABC。

如果Sheet1_1存在並且我們要求新的Sheet1，它將返回Sheet1_2，因爲ABC不存在於新的工作簿中，它將返回ABC。

測試代碼添加一個名爲'DEF'的新工作表。如果你再次運行它，它會創建'DEF_1'。

Sub Test() 

    Debug.Print RenameSheet("Sheet1") 
    Debug.Print RenameSheet("Sheet2") 
    Debug.Print RenameSheet("ABC") 

    Dim wrkSht As Worksheet 
    Set wrkSht = Worksheets.Add 
    wrkSht.Name = RenameSheet("DEF") 

End Sub 

    Public Function RenameSheet(SheetName As String, Optional Book As Workbook) As String 

     Dim lCounter As Long 
     Dim wrkSht As Worksheet 

     If Book Is Nothing Then 
      Set Book = ThisWorkbook 
     End If 

     lCounter = 0 
     On Error Resume Next 
      Do 
       'Try and set a reference to the worksheet. 
       Set wrkSht = Book.Worksheets(SheetName & IIf(lCounter > 0, "_" & lCounter, "")) 
       If Err.Number <> 0 Then 
        'If an error occurs then the sheet name doesn't exist and we can use it. 
        RenameSheet = SheetName & IIf(lCounter > 0, "_" & lCounter, "") 
        Exit Do 
       End If 
       Err.Clear 
       'If the sheet name does exist increment the counter and try again. 
       lCounter = lCounter + 1 
      Loop 
     On Error GoTo 0 

    End Function 

編輯：刪除了Do While bNotExists因爲我不檢查bNotExists - 只用Exit Do代替。

Answer 3

建立在達倫的答案上，我認爲只是馬上重新命名錶格而不是返回可以使用的名稱可能更容易。我也重構了一下。這是我的看法：

Private Sub nameNewSheet(sheetName As String, newSheet As Worksheet) 
    Dim named As Boolean, counter As Long 
    On Error Resume Next 
     'try to name the sheet. If name is already taken, start looping 
     newSheet.Name = sheetName 
     If Err Then 
      If Err.Number = 1004 Then 'name already used 
       Err.Clear 
      Else 'unexpected error 
       GoTo nameNewSheet_Error 
      End If 
     Else 
      Exit Sub 
     End If 

     named = False 
     counter = 1 

     Do 
      newSheet.Name = sheetName & counter 
      If Err Then 
       If Err.Number = 1004 Then 'name already used 
        Err.Clear 
        counter = counter + 1 'increment the number until the sheet can be named 
       Else 'unexpected error 
        GoTo nameNewSheet_Error 
       End If 
      Else 
       named = True 
      End If 
     Loop While Not named 

     On Error GoTo 0 
     Exit Sub 

    nameNewSheet_Error: 
    'add errorhandler here 

End Sub