VBA Excel Incremented worksheet name Add After Statement using a stored variable sheet name

huangapple go评论68阅读模式
英文:

VBA Excel Incremented worksheet name Add After Statement using a stored variable sheet name

问题

如何在Excel中使用VBA在特定工作表名称(由变量保存)后添加工作表?

我尝试了以下代码:
Set sh = wb.Worksheets.Add(After:=wb.Sheets(wsPattern & CStr(n)))

先前递增的工作表名称存储在"wsPattern & CStr(n)"中,新的工作表名称会根据另一个语句和变量递增,但使用上述语法添加失败。我在这一行遇到"超出范围"的错误。

使用以下语句,代码会完全执行,但会将任何新创建的工作表添加到所有工作表的末尾:
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

'添加到工作簿的末尾
'Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))

'测试-在最后递增的工作表后添加-
Set sh = wb.Worksheets.Add(After:=wb.Sheets(wsPattern & CStr(n)))

sh.Name = wsPattern & CStr(n)
End Sub
英文:

How to add a worksheet in excel with VBA after a specific sheetname held by variable?

I tried:
Set sh = wb.Worksheets.Add(After:=wb.Sheets(wsPattern & CStr(n)))

The previous incremented sheetname is stored in "wsPattern & CStr(n)", The new sheetname increments up properly from another statement and variable, but the add after fails with the above syntax. I'm getting an out of range error at this line.

The code fully executes using this statement, but adds any newly created sheets from any given series at the end of all sheets:
Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))

As the workbook has 4 series of sheet names now (e.g. Test1, logistic1, Equip1, Veh1, etc.) that are incremented up as they are added, the next incremented sheet for a given series needs to be added to the end of that sheet name series (Equip2 should be after Equip1) and not at the end of all sheets.

    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 

答案1

得分: 0

创建一个函数

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
        ' 查找系列中的最后一个工作表
        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
        ' 如果找不到,添加到最后
        If i = 0 Then
           n = .Sheets.Count
        End If
        ' 增加系列
        s = sSeries & i + 1
        .Sheets.Add after:=.Sheets(n)
        .Sheets(n + 1).Name = s
    End With
    AddSheet = s

End Function
英文:

Create a function

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

</details>



huangapple
  • 本文由 发表于 2023年2月14日 22:35:58
  • 转载请务必保留本文链接:https://go.coder-hub.com/75449356.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定