VBA Excel根据创建的上一个工作表添加带有编号的新工作表

Question

我有一张名为“区域地图 1”的工作表。 我想创建一个按钮，它将为我添加名为“区域地图 2”的新工作表（复制“区域地图 1”）。 该按钮将仅添加一张纸。这意味着，如果我们需要创建更多工作表，它可以重复使用。但是，如果我使用此按钮一次，那么我在此名称下的最后一个现有工作表是“区域地图 2”。再次使用该按钮将导致错误“名称已被占用，请尝试其他名称”。

那么我应该在下面的代码中改进什么？

  Sub ConsecutiveNumberSheets()
  Dim ws As Worksheet
  Dim i As Long
  For i = 1 To Sheets.Count - (Sheets.Count - 1)
  With Sheets("Area Map 1")
  .Copy after:=ActiveSheet
  ActiveSheet.Name = "Area Map " & (i + 1)
  .Select
  End With
  Next i
  End Sub

我想要一些东西，它会检测到已经创建了带有递增数字的新工作表。我应该怎么做才能使我的代码基于现有工作表的最后一个数字？

Answer 1

添加增量工作表

Option Explicit

Sub createIncrementedWorksheet()
    
    Const wsPattern As String = "Area Map "
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim arr() As Long: ReDim arr(1 To wb.Sheets.Count)
    Dim wsLen As Long: wsLen = Len(wsPattern)
    
    Dim sh As Object
    Dim cValue As Variant
    Dim shName As String
    Dim n As Long
    
    For Each sh In wb.Sheets
        shName = sh.Name
        If StrComp(Left(shName, wsLen), wsPattern, vbTextCompare) = 0 Then
            cValue = Right(shName, Len(shName) - wsLen)
            If IsNumeric(cValue) Then
                n = n + 1
                arr(n) = CLng(cValue)
            End If
        End If
    Next sh
    If n = 0 Then
        n = 1
    Else
        ' If you just want the number to be one greater then the greatest,
        ' you can use the one liner...
        'n = Application.Max(arr) + 1
        ' ... instead of the following before 'End If':
        ReDim Preserve arr(1 To n)
        For n = 1 To n
            If IsError(Application.Match(n, arr, 0)) Then
                Exit For
            End If
        Next n
    End If
            
    Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    sh.Name = wsPattern & CStr(n)

End Sub

Answer 2

这应该可以满足您的需求。

Public Sub CreateSheet()
    Dim wb As Workbook: Set wb = ActiveWorkbook
    Dim ws As Worksheet
    Dim startName As String: startName = "Area Map "
    Dim counter As Integer: counter = 1
    
    For Each ws In wb.Sheets                      
        If Left(ws.Name, Len(startName)) = startName Then
            counter = counter + 1
        End If            
    Next ws
    
    Set ws = wb.Sheets.Add
    startName = startName & counter
    ws.Name = startName
End Sub