英文:
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>
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论