编写VBA创建工作表时触发428错误，请求排查解决

错误428（对象不支持此属性或方法）的原因及修复代码 #

错误428源于代码中多处对象引用、语法和变量声明的问题，以下是关键问题点及修复后的完整代码：

核心问题说明

1. 函数返回值语法错误：原代码中Set Items_Ordered(WkBk) = ...是错误写法，返回工作表对象无需传入参数，直接赋值即可。
2. 工作表添加参数错误：Worksheets.Add的After参数需要传入工作表对象，而非字符串名称。
3. 未限定工作表的Range/Cells引用：多处Cells、Range未指定所属工作表，默认引用活动表导致对象混淆。
4. 变量声明不规范：VBA中一行声明多个变量时，仅最后一个会被指定类型，其余为Variant，需逐个声明类型。
5. 未处理Find方法返回空的情况：若未找到"Delivery Charge"，直接调用Delivery_Charge.Row会触发错误。
6. 数值赋值错误：直接将Range赋值给Integer变量，需用Sum函数计算总和。

修复后的完整代码

Option Explicit
Option Base 1

Sub Licious()
    Dim Files As Variant
    Dim WkBk As Workbook
    Dim WkSh As Worksheet, WkSh2 As Worksheet
    Dim i As Integer

    Files = Application.GetOpenFilename(Title:="Select the bills for Licious", FileFilter:="Excel Files(*.xls*), *.xls", MultiSelect:=True)

    If IsArray(Files) Then
        For i = 1 To UBound(Files)
            Set WkBk = Workbooks.Open(Files(i))
            
            ' 删除"Table 10"以外的所有工作表
            For Each WkSh In WkBk.Worksheets
                If WkSh.Name <> "Table 10" Then WkSh.Delete
            Next WkSh
            
            Set WkSh2 = Items_Ordered(WkBk)
            WkSh2.Activate
        Next i
    End If
End Sub

Function Items_Ordered(WkBk As Workbook) As Worksheet
    Dim Cell As Range, Delivery_Charge As Range, Item_Range As Range
    Dim Item_Count As Integer, Counter As Integer, Row_Id As Integer, Total_Qty As Integer
    Dim wsTable10 As Worksheet, wsItemsOrdered As Worksheet
    Dim lastRow As Long

    ' 绑定"Table 10"工作表
    Set wsTable10 = WkBk.Worksheets("Table 10")
    
    ' 计算B列数据总和
    lastRow = wsTable10.Cells(2, 2).End(xlDown).Row
    Total_Qty = Application.WorksheetFunction.Sum(wsTable10.Range("B2:B" & lastRow))

    ' 在"Table 10"后添加新工作表
    Set wsItemsOrdered = WkBk.Worksheets.Add(After:=wsTable10)
    
    ' 配置新工作表表头与格式
    With wsItemsOrdered
        .Name = "Items Ordered"
        .Range("A1") = "Date"
        .Range("B1") = "Narration"
        .Range("C1") = "Chq./Ref.No."
        .Range("D1") = "Value Dt"
        .Range("E1") = "Withdrawal Amt."
        .Range("F1") = "Deposit Amt."
        .Range("G1") = "Closing Balance"
        .Range("H1") = "Expense Line"
        .Range("I1") = "Comments"
        .Columns("A:H").ColumnWidth = 18.33
    End With

    ' 查找"Delivery Charge"行
    Set Delivery_Charge = wsTable10.Range("A:A").Find(What:="Delivery Charge", LookIn:=xlValues, LookAt:=xlWhole)
    
    ' 未找到目标行时提示并退出
    If Delivery_Charge Is Nothing Then
        MsgBox "未找到'Delivery Charge'行", vbExclamation
        Set Items_Ordered = wsItemsOrdered
        Exit Function
    End If

    ' 定义需要处理的项目范围
    Set Item_Range = wsTable10.Range("A2:A" & Delivery_Charge.Row - 1)

    ' 仅当新工作表H2为空时执行数据转移
    If IsEmpty(wsItemsOrdered.Range("H2")) Then
        For Each Cell In Item_Range
            Item_Count = Cell.Offset(0, 1).Value
            
            ' 避免数量为0导致无效循环
            If Item_Count > 0 Then
                For Counter = 1 To Item_Count
                    ' 获取H列最后一行的下一行行号
                    Row_Id = wsItemsOrdered.Cells(wsItemsOrdered.Rows.Count, "H").End(xlUp).Row + 1
                    
                    wsItemsOrdered.Range("A" & Row_Id) = CDate(VBA.Replace(WkBk.Name, ".xlsx", ""))
                    wsItemsOrdered.Range("H" & Row_Id) = Cell.Value
                    wsItemsOrdered.Range("E" & Row_Id) = -(Cell.Offset(0, 3).Value / Item_Count)
                Next Counter
            End If
        Next Cell
    End If

    ' 返回创建好的工作表对象
    Set Items_Ordered = wsItemsOrdered
End Function

内容的提问来源于stack exchange，提问作者Varun Kapur