VBA Excel增量工作表名称使用存储变量工作表名称的Add After语句

muk1a3rh  于 2023-02-17  发布在  其他
关注(0)|答案(1)|浏览(127)

如何用VBA在excel中在变量持有的特定sheetname后添加工作表?
我试过了:Set sh = wb.Worksheets.Add(After:=wb.Sheets(wsPattern & CStr(n)))
之前增加的sheetname存储在"wsPattern & CStr(n)"中,新的sheetname从另一个语句和变量中正确地增加,但是在上面的语法中添加失败。我在这一行得到了一个超出范围的错误。
代码使用此语句完全执行,但会将任何给定系列中新创建的图纸添加到所有图纸的末尾:Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
由于工作簿现在有4个系列的工作表名称(例如Test1、logistic1、Equip1、Veh1等),这些工作表名称在添加时递增,因此需要将给定系列的下一个递增工作表添加到该工作表名称系列的末尾(Equip2应在Equip1之后),而不是所有工作表的末尾。

Sub CreaIncWkshtEquip()
    
    Const wsPattern As String = "Equip "
    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
        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
    
    'adds to very end of workbook
    'Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    
    'Test-Add After Last Incremented Sheet-
    Set sh = wb.Worksheets.Add(After:=wb.Sheets(wsPattern & CStr(n)))
       
    sh.Name = wsPattern & CStr(n)
End Sub
cbjzeqam

cbjzeqam1#

创建函数

Sub Demo()
   Dim s
   s = AddSheet("SeriesName")
   MsgBox s & " Added"
End Sub

Function AddSheet(sSeries As String) As String

    Dim ws, s As String, i As Long, n As Long
    With ThisWorkbook
        ' find last in series
        For n = .Sheets.Count To 1 Step -1
            s = .Sheets(n).Name
            If s Like sSeries & "[1-9]*" Then
                i = Mid(s, Len(sSeries) + 1)
                Exit For
            End If
        Next
        ' not found add to end
        If i = 0 Then
           n = .Sheets.Count
        End If
        ' increment series
        s = sSeries & i + 1
        .Sheets.Add after:=.Sheets(n)
        .Sheets(n + 1).Name = s
    End With
    AddSheet = s

End Function

相关问题