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

Question

如果名称已经存在，如何重命名工作表并在名称末尾添加数字?

我正在使用这个代码，但需要添加一个数字到表名的结束，如果名称已经存在。

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

Answer 1

下面的代码循环遍历ThisWorkbook中的所有工作表，并检查是否已经有一个名为"New name "的工作表，如果有，则在末尾添加一个数字。

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

基于Darren的回答，我认为直接重命名表单比返回可用的名称更容易。我也做了一些重构。以下是我的看法:

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

Answer 4

.net版本的VB使用Try…Catch公式捕获运行时错误，请参阅{https://msdn.microsoft.com/en-us/library/ms973849.aspx}(https://msdn.microsoft.com/en-us/library/ms973849.aspx)与旧的VB6和以前的"on error"公式的比较。它更适合做您想做的事情，并且会缩短异常运行时间。

我试图找出什么异常抛出时，试图重命名为现有的工作表名，并将在这里编辑到一个可行的脚本，当我找到它。