添加具有连续名称的工作表

Adding Sheets With Sequential Names

我需要编写一个宏,在执行时添加一个新的 sheet。 sheet 名称将是 "Combined-n",其中 n 是一个整数。我想让它尝试添加一个名为 "Combined-1" 的新 sheet。但是,如果 sheet "Combined-1" 已经存在(因为这个宏可以多次执行),我希望它添加一个名为 "Combined-2" 的 sheet 等等。我尝试了一些不同的东西,包括下面的代码,但是当我执行它时没有任何反应。

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

编写一个函数,其唯一的工作就是 return 下一个 "Combined-N" sheet 的名称。我会通过计算名称以 "Combined-" 开头的 sheet 的数量并将该数字加 1,然后递增直到 "Combined-" 与该数字连接sheet 尚不存在的名称。

所以,我有一个 GetNextCombinedSheetName 函数来执行此操作,还有一个 SheetNameExists 函数来确定给定的 sheet 名称是否存在于可选指定的 [=14] =] 的 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
    Loop While 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

这样,您可以添加一个新的 sheet 并命名为:

Dim newSheet As Worksheet
Set newSheet = ThisWorkbook.Worksheets.Add
newSheet.Name = GetNextCombinedSheetName

请注意每个 Worksheets 成员调用(或 Sheets - 但为什么您交替使用两者且不一致?)如何使用 Workbook 对象正确限定:您的代码出现有几个 implicit ActiveWorkbook references,这只有效,因为 ActiveWorkbook 恰好是 主机 ThisWorkbook 文档 - 情况可能并非总是如此(特别是当你学会停止 Activate-ing 和 Select-ing 事情时),并且你不希望你的代码假设它是:当我们系统地限定工作簿和工作时,生活会简单得多sheet 会员来电.

@chrisphils26 - 你也可以试试下面的代码

Option Explicit

Sub GetAvailableSheeName()

Dim sht As Worksheet
Dim temp_sht
Dim sht_name, last_sht As String
Dim shtNumber
Dim temp_counter, loop_i, counter, num As Integer

Const Available_sht As String = "Combined-"

temp_counter = 0
For Each sht In ThisWorkbook.Worksheets

    If LCase(Left(sht.name, Len(Available_sht))) = LCase(Available_sht) Then

        shtNumber = Split(sht.name, "-")(1)

        If IsNumeric(shtNumber) Then
            If shtNumber > temp_counter Then
                temp_counter = shtNumber
                last_sht = sht.name
            End If

        Else
            sht_name = sht.name

        End If

    Else
            sht_name = sht.name
    End If

Next sht

If temp_counter = 0 Then

   ThisWorkbook.Sheets.Add(After:=Sheets(sht_name)).name = "Combined-1"
Else

   ThisWorkbook.Sheets.Add(After:=Sheets(last_sht)).name = "Combined-" & temp_counter + 1

    For loop_i = 1 To temp_counter + 1

        For Each sht In ThisWorkbook.Worksheets
             counter = 0
             If LCase("Combined-") & loop_i = LCase(sht.name) Then

               counter = 1
               Exit For
             End If

        Next sht

         If counter = 0 Then
            If loop_i = 1 Then
              ThisWorkbook.Sheets.Add(Before:=Sheets(1)).name = "Combined-" & loop_i
            Else
              num = loop_i - 1
              ThisWorkbook.Sheets.Add(After:=Sheets("Combined-" & num)).name = "Combined-" & loop_i
            End If

         End If

        Next loop_i
End If

End Sub