添加具有顺序名称的工作表

Question

我需要编写一个在执行时添加新工作表的宏。工作表名称为“ Combined-n”，其中n为整数。我希望它尝试添加一个名为“ Combined-1”的新表。但是，如果工作表“ Combined-1”已经存在（因为此宏可以多次执行），我希望它添加一个名为“ Combined-2”的工作表，依此类推。我尝试了一些其他的事情，包括下面的代码，但是当我执行它时，什么也没发生。

Dim i As Integer
Dim WS As Worksheet

For Each WS In ThisWorkbook.Worksheets
WS.Activate
For i = 1 To Worksheets.Count
If WS.Name = "Combined-" & i Then
Sheets.Add(Before:=Sheets("Sheet1")).Name = "Combined-" & i + 1
End If
Next i
Next WS

我也尝试过：

Dim i As Integer

For i = 1 To Worksheets.Count
   If Worksheets(i).Name = "Combined-" & i Then
   Sheets.Add(Before:=Sheets("Sheet1")).Name = "Combined-" & i + 1
End If
Next i

Answer 1

编写一个函数，其唯一的工作就是返回下一个“ Combined-N”工作表的名称。我可以通过计算具有以“ Combined-”开头的名称的工作表的数量，然后在该数字上加1，然后递增直到与该数字连接的“ Combined-”是不存在的工作表名称已经存在。

因此，我将具有GetNextCombinedSheetName函数来执行此操作，并具有SheetNameExists函数来确定给定工作表名称是否存在于可选的Workbook的Worksheets集合中。

类似这样的东西：

Public Function GetNextCombinedSheetName() As String
    Const namePrefix As String = "Combined-"

    Dim currentcount As Long

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If Left(ws.Name, Len(namePrefix)) = namePrefix Then
            currentCount = currentCount + 1
        End If
    Next

    Dim nextName As String
    Do 'ensure the name doesn't already exist - increment if it does:
        nextName = namePrefix & currentCount + 1
    While Not SheetNameExists(nextName)

    GetNextCombinedSheetName = nextName
End Function

Private Function SheetNameExists(ByVal sheetName As String, Optional ByVal wb As Workbook = Nothing) As Boolean
    If wb Is Nothing Then Set wb = ThisWorkbook
    Dim ws As Worksheet
    On Error Resume Next ' swallow index out of bounds error 9
    Set ws = wb.Worksheets(sheetName)
    On Error GoTo 0
    SheetNameExists = Not ws Is Nothing
End Function