命名工作表VBA时出现1004应用程序定义或对象定义的错误

Question

我想在现有工作簿中重命名工作表。 这是我正在使用的代码：

Dim LobArray As Variant
Dim TypeArray As Variant 
Dim g As String  

'Added during Edit of question.
Dim NoLobs As Long, NoTypes As Long
Dim l As Long, t As Long, s As Long
Dim SheetNames(100) As String
Dim SheetCountSpL As Long
Dim TmplSpl As Workbook
Set TmplSpl = ThisWorkbook
'-----------------------------

g = "_"
LobArray = Array("Lob1", "Lob2", "Lob3", "Lob4")
TypeArray = Array("ea", "pa", "inc")
NoLobs = UBound(LobArray) - LBound(LobArray) + 1
NoTypes = UBound(TypeArray) - LBound(TypeArray) + 1
For l = LBound(LobArray) To UBound(LobArray)
        For t = LBound(TypeArray) To UBound(TypeArray)
            SheetNames(l * NoLobs + t) = LobArray(l) & g & TypeArray(t)
            Next t
 Next l
SheetCountSpL = NoTypes * NoLobs
For s = 1 To SheetCountSpL
    TmplSpL.Worksheets(s).Activate
    TmplSpL.Worksheets(s).Name = SheetNames(s - 1)
  Next s

当我将LobArray中的元素减少到3时，它可以工作。 基本上，当宏必须重命名超过9张工作表时，我得到了标题中提到的错误。

Answer 1

这是我用来创建和重命名工作表的代码。 它根据选定的单元格创建工作表，并相应地重命名新工作表。 如果存在工作表，则将其删除

Sub CreateSheetsFromAList()


Dim MyCell As Range
Dim MyRange As Range

Set MyRange = Selection

For Each MyCell In MyRange

    Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
    On Error Resume Next
    Sheets(Sheets.Count).Name = MyCell.Value 'renames the new worksheet
    If Err.Number = 1004 Then
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    End If
    On Error GoTo 0

Next MyCell
End Sub

Answer 2

这是错误：

LobArray =四个元素。
TypeArray =三个元素。

1. l = 0 ， NoLobs = 4 ，在第一个循环上t = 0 。
   • 第一个内循环：
     0 * 4 + 0 = 0 = SheetNames(0) = LobArray(0) & TypeArray(0) = "Lob1_ea"
   • 第二个内循环：
     0 * 4 + 1 = 1 = SheetNames(1) = .....
   • 第三内循环：
     0 * 4 + 2 = 2 = SheetNames(2) = .....
   • 第四内循环：
     因为TypeArray只有3个元素， TypeArray不会发生。
     结果，SheetNames（3）留为空白

此代码将重命名您的工作表：

Public Sub Test()

    Dim LobArray As Variant
    Dim TypeArray As Variant
    Dim lobItm As Variant, typeItm As Variant
    Dim g As String, x As Long
    Dim RequiredSheetCount As Long

    g = "_"
    LobArray = Array("Lob1", "Lob2", "Lob3", "Lob4")
    TypeArray = Array("ea", "pa", "inc")

    RequiredSheetCount = (UBound(LobArray) + 1) * (UBound(TypeArray) + 1)

    If Worksheets.Count >= RequiredSheetCount Then
        For Each lobItm In LobArray
            For Each typeItm In TypeArray
                x = x + 1
                ThisWorkbook.Worksheets(x).Name = lobItm & g & typeItm
            Next typeItm
        Next lobItm
    Else
        MsgBox "The workbook needs at least " & RequiredSheetCount & " sheets to work properly."
    End If

End Sub