Excel VBA创建类模块对象数组遇Runtime 91错误及替代方案咨询

我有一个包含3个工作表的Excel文件：

• Worksheet(1)：存储多品牌商品信息，列结构为A(品牌名)、B(商品名)、C(商品选项)、D(净价)、E(汇率)、F(数量)，其中A-C列固定，D-F及右侧列会随价格、汇率、数量变动新增数据；
• Worksheet(2)：存储各品牌支出信息，列结构为A(品牌名)、B(运费)、C(附加费)、D(关税)、E(汇率)，A列固定，B-E及右侧列会新增数据；
• Worksheet(3)：用于展示各品牌支出与收益总览。

我设计了两个类模块：ItemData存储商品数据，BrandData存储品牌数据，主脚本计划读取Worksheet(1)的单元格数据，将商品信息存入ItemData后归类到对应的BrandData中。

我知道不推荐把类模块对象存入动态数组，想找替代方案；同时当前代码运行时出现Runtime 91错误，需要解决。相关代码如下：

初始类模块设计 #

' *ItemData*
Private brandName As String
Private ItemName As String
Private Option As String
Dim BatchPrice() As Variant '存储净价、汇率、数量的乘积
 
' *BrandData*
Private Shipping As Double
Private Surcharges As Double
Private Customs As Double
Private ExchangeRate As Double
Dim itemBatch() As ItemData

实际使用的类模块 ItemInfo #

Class Module ItemInfo
Option Explicit

Private brandName As String
Private Itemname As String
Private Options As String
Private netWorth As Double
Private arraySize As Integer
Dim StockPrice() As Variant

Property Let setBrandname(iBrandname As String)
    brandName = iBrandname
End Property

Property Get getBrandname() As String
    getBrandname = brandName
End Property

Property Let setItemname(pItemname As String)
    Itemname = pItemname
End Property

Property Get getItemname() As String
    getItemname = Itemname
End Property

Property Let setOptions(iOptions As String)
    Options = iOptions
End Property

Property Get getOptions() As String
    getOptions = Options
End Property

Property Let setNetworth(iNetWorth As Double)
    netWorth = iNetWorth
End Property

Property Get getNetworth() As Double
    getNetworth = netWorth
End Property

Property Let setArraySize(iArraysize As Integer)
    arraySize = iArraysize
End Property

Property Get getArraySize() As Integer
    getArraySize = arraySize
End Property

Property Get getPrice() As Variant
    getPrice = StockPrice()
End Property

Property Let setPrice(ByVal rawInput As Long)
    ReDim Preserve StockPrice(arraySize)
    StockPrice(arraySize) = rawInput
End Property


Private Sub Class_Initialize()
    brandName = ""
    Itemname = ""
    Options = ""
    netWorth = 0
    arraySize = 0
End Sub

类模块 BrandItems #

Option Explicit

Private Index As Integer
Private name As String
Dim BrandItems() As ItemInfo

Property Let setName(Iname As String)
    name = Iname
End Property

Property Get getName() As String
    getName = name
End Property

Property Let setItems(target As ItemInfo)
    ReDim Preserve BrandItems(Index)
    Set BrandItems(Index) = New ItemInfo
    BrandItems(Index) = target
End Property

Property Get getItems() As ItemInfo
    getItems = BrandItems()
End Property

Property Let setIndex(bIndex As Integer)
    Index = bIndex
End Property

Property Get getIndex() As Integer
    getIndex = Index
End Property

Private Sub Class_Initialize()
    Index = 0
    name = ""
End Sub

主脚本 ReadData #

Sub ReadData()

Dim srcsheet As Worksheet
Dim items As ItemInfo
Dim brandList() As BrandItems

Dim rCount As Integer
Dim lCount As Integer
Dim itemCount As Integer
Dim BrandArraySize As Integer
Dim BrandCount As Integer

Dim brandIndex As Long
Dim currPrice As Double
Dim tempBrand As String

Set srcsheet = Worksheets(Sheets(1).name)
rCount = srcsheet.Cells(Rows.Count, 1).End(xlUp).Row
lCount = srcsheet.Cells(1, Columns.Count).End(xlToLeft).Column

'There are 700+ items that share identical brands so I'll sort them out'
For y = 2 To rCount 
    If y = 2 Then
        BrandCount = 1
        tempBrand = Cells(y, 1)
    Else
        If Not Cells(y, 1) = tempBrand Then
            BrandCount = BrandCount + 1
            tempBrand = Cells(y, 1)
        End If
    End If
Next y

ReDim brandList(BrandCount)
Set brandList(BrandCount) = New BrandItems

For y = 2 To rCount
    Set items = New ItemInfo
    
    For x = 1 To lCount
        If Cells(y, x).Value() = "" Then
            Exit For
        End If
        
        Call sortValue() 'This function fills up ItemInfo class'
    Next x

    itemRawPrice = items.getPrice()

    For Each productNet In itemRawPrice
        items.setNetworth = items.getNetworth + productNet
    Next productNet

    BrandArraySize = 0 'Checks how many Brands are in the List'
    
    If BrandArraySize = 0 Then
        brandList(0).setIndex = 0 'Here's where runtime error 91 appears'
        brandList(0).setItems = items
        brandList(0).setName = items.getBrandname
        BrandArraySize = BrandArraySize + 1
    Else
        For a = 0 To BrandArraySize
            If brandList(a).getName = items.getBrandname Then 'Since the brand already exist in the List, just add items to the array'
                brandList(a).setIndex = brandList(0).getIndex + 1
                brandList(a).setItems = items
            Else
                brandList(a).setIndex = 0
                brandList(a).setItems = items
                brandList(a).setName = items.getBrandname
                BrandArraySize = BrandArraySize + 1
            End If
        Next a
    End If
Next y

一、修复Runtime 91错误（对象变量未设置） #

错误出现在brandList(0).setIndex = 0，原因是数组brandList仅实例化了最后一个元素，其余位置的BrandItems对象为Nothing。

修复步骤： #

1. 初始化数组时为所有元素创建BrandItems对象，同时修正数组索引范围：

' 先正确统计品牌数量（建议用字典去重，避免未排序导致的统计错误）
Dim brandDict As Object
Set brandDict = CreateObject("Scripting.Dictionary")
For y = 2 To rCount
    brandDict(srcsheet.Cells(y, 1).Value) = ""
Next y
BrandCount = brandDict.Count

' 初始化数组并为每个元素创建对象
ReDim brandList(BrandCount - 1) ' 索引从0开始，避免越界
For i = 0 To UBound(brandList)
    Set brandList(i) = New BrandItems
Next i

2. 所有Cells调用必须指定工作表，避免使用当前活动表：
   将Cells(y, x)改为srcsheet.Cells(y, x)。

二、替代动态数组存储类对象的方案 #

动态数组管理类对象效率低且易出错，推荐以下两种方案：

1. 使用Collection集合 #

Collection支持动态增删对象，无需手动调整数组大小：

• 修改BrandItems类，用集合替代动态数组：

Option Explicit

Private name As String
Private itemCol As Collection

Property Let setName(Iname As String)
    name = Iname
End Property

Property Get getName() As String
    getName = name
End Property

' 添加商品对象
Public Sub AddItem(target As ItemInfo)
    itemCol.Add target
End Sub

' 获取指定索引的商品
Public Function GetItem(index As Integer) As ItemInfo
    Set GetItem = itemCol(index)
End Function

' 获取商品总数
Public Function GetItemCount() As Integer
    GetItemCount = itemCol.Count
End Function

Private Sub Class_Initialize()
    name = ""
    Set itemCol = New Collection
End Sub

2. 使用Scripting.Dictionary字典（推荐） #

用品牌名作为键，直接定位对应品牌的BrandItems对象，避免遍历查找，效率更高：

• 主脚本中替换动态数组为字典：

Dim brandDict As Object
Set brandDict = CreateObject("Scripting.Dictionary")

For y = 2 To rCount
    Set items = New ItemInfo
    ' 填充items数据（需完善sortValue函数，传入工作表、行列号和items对象）
    ' ...
    
    ' 计算商品总价值
    ' ...
    
    Dim currBrand As String
    currBrand = items.getBrandname
    
    ' 处理品牌存在与否的逻辑
    If brandDict.Exists(currBrand) Then
        brandDict(currBrand).AddItem items
    Else
        Dim newBrand As BrandItems
        Set newBrand = New BrandItems
        newBrand.setName = currBrand
        newBrand.AddItem items
        brandDict.Add currBrand, newBrand
    End If
Next y

三、其他代码优化点 #

1. ItemInfo类中setPrice参数类型改为Double（适配价格小数），并自增数组索引：

Property Let setPrice(ByVal rawInput As Double)
    ReDim Preserve StockPrice(arraySize)
    StockPrice(arraySize) = rawInput
    arraySize = arraySize + 1 ' 避免覆盖已有数据
End Property

2. 完善sortValue函数，传递必要参数避免依赖全局变量：

Sub sortValue(ByVal ws As Worksheet, ByVal rowNum As Integer, ByVal colNum As Integer, ByRef itemObj As ItemInfo)
    Select Case colNum
        Case 1: itemObj.setBrandname = ws.Cells(rowNum, colNum).Value
        Case 2: itemObj.setItemname = ws.Cells(rowNum, colNum).Value
        Case 3: itemObj.setOptions = ws.Cells(rowNum, colNum).Value
        Case Else:
            ' 计算净价*汇率*数量并存入StockPrice
            Dim netPrice As Double, rate As Double, qty As Double
            netPrice = ws.Cells(rowNum, colNum).Value
            rate = ws.Cells(rowNum, colNum + 1).Value
            qty = ws.Cells(rowNum, colNum + 2).Value
            itemObj.setPrice = netPrice * rate * qty
            colNum = colNum + 2 ' 跳过汇率和数量列
    End Select
End Sub

内容的提问来源于stack exchange，提问作者David Kim