VBA Excel添加新的工作表，其编号基于之前创建的工作表 [英] VBA Excel add new sheet with number based on the previous sheet created

问题描述

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

I have the Sheet called "Area Map 1". I want to create the button, which will add the new sheet for me (copy the "Area Map 1") with the name Area Map 2. The button is going to add one sheet only. It means, that it can be used repeatedly if we need to create more sheets. However, if I use this button once, then my last existing sheet under this name is "Area Map 2". Using the button again will result from the error "The name is already taken, try the different one".

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

What should I improve in the code below then?

  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

我想要一些东西，它将检测到已经创建了带有递增编号的新工作表.我应该怎么做才能使代码基于已经存在的工作表的最后一个?

I want something, which will detect, that the new sheet with incremented numbers is already created. What should I do to base my code on the last number of the already existing sheets?

推荐答案

添加增量工作表

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

这篇关于VBA Excel添加新的工作表，其编号基于之前创建的工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！