如果工作表名称已存在，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