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

Question

我有一张名为“区域 map 1”的表格。
我想创建一个按钮，它将为我添加名为“区域 map 2”的新工作表(复制“区域 map 1”)。
该按钮将只添加一张纸。这意味着，如果我们需要创建更多工作表，它可以重复使用。但是，如果我使用此按钮一次，那么我在此名称下的最后一个现有工作表是“区域 map 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