如何使函数返回 VBA 中的对象列表

Posted 2023-04-19

技术标签:

【中文标题】如何使函数返回 VBA 中的对象列表【英文标题】：How to make a function to return a list of objects in VBA 【发布时间】：2017-03-16 08:51:23 【问题描述】：

我有一个表，我想将该表中的每一行转换为一个对象。该对象将具有每一列的属性。

我做了这个功能：

Public Function GetProducts() As Object
   Set GetProducts = New Collection

    Dim p As New ProductInfo
    Dim rng As Range
    Dim xRow As Range

    Set rng = Sheet2.Range("A2:I" & Sheet2.Range("A2").End(xlDown).Row)

        For Each xRow In rng.Rows

            p.Id = xRow.Cells(1, 1).Value
            p.Cod = xRow.Cells(1, 2).Value
            p.Name = xRow.Cells(1, 3).Value
            p.productType = xRow.Cells(1, 4).Value
            p.norma = xRow.Cells(1, 5).Value
            p.masina = xRow.Cells(1, 6).Value
            p.masinaType = xRow.Cells(1, 7).Value
            p.operatori = xRow.Cells(1, 8).Value
            p.sectie = xRow.Cells(1, 9).Value

            GetProducts.Add Item:=p, Key:=CStr(p.Id)

        Next xRow

End Function

比我尝试用这个 Sub 来检查函数：

Public Sub CheckProducts()
    Dim products As Collection
    Dim p As ProductInfo
    Set products = GetProducts()

        For Each p In products
            MsgBox p.Id
        Next p

End Sub

msgbox 总是返回 20（我的表中有 20 个项目，最后一个 ID 是 20）。

当我检查收集的项目数量时，我得到了 20 个，这与我预期的一样。

谁能帮我理解为什么我不能迭代集合并获取每个项目的 id？

【问题讨论】：

介意发布您的 ProductInfo 代码吗？愚蠢的明显问题 - A 列确实具有唯一值，不是吗？ 【参考方案1】：

在GetProducts()你需要编码：

Dim p As ProductInfo

而不是：

Dim p As New ProductInfo

然后在循环代码中：

Set p = New ProductInfo

这是一个例子：

数据

类 - `TestInfo`

Private m_Id As String
Private m_Code As String
Private m_Name As String

Property Get Id() As String
    Id = m_Id
End Property
Property Let Id(str As String)
    m_Id = str
End Property

Property Get Code() As String
    Code = m_Code
End Property
Property Let Code(str As String)
    m_Code = str
End Property

Property Get Name() As String
    Name = m_Name
End Property
Property Let Name(str As String)
    m_Name = str
End Property

模块

Option Explicit

Sub Test()
    Dim coll As Collection
    Dim obj As TestInfo

    Set coll = GetProducts

    For Each obj In coll
        MsgBox obj.Name
    Next
End Sub

Public Function GetProducts() As Collection

    Set GetProducts = New Collection

    Dim rngData As Range
    Dim lngCounter As Long
    Dim obj As TestInfo '<--- do not use New here

    Set rngData = ThisWorkbook.Worksheets("Sheet1").Range("A1:C7")

    For lngCounter = 2 To rngData.Rows.Count
        Set obj = New TestInfo '<--- use New here

        obj.Id = rngData.Cells(lngCounter, 1).Value
        obj.Code = rngData.Cells(lngCounter, 2).Value
        obj.Name = rngData.Cells(lngCounter, 3).Value

        GetProducts.Add obj

    Next lngCounter

End Function

注意

而且我个人也不会使用这种说法：

Set GetProducts = New Collection

我会这样做：

Public Function GetProducts() As Collection

    Dim coll As Collection
    Dim rngData As Range
    Dim lngCounter As Long
    Dim obj As TestInfo

    Set rngData = ThisWorkbook.Worksheets("Sheet1").Range("A1:C7")
    Set coll = New Collection

    For lngCounter = 2 To rngData.Rows.Count
        Set obj = New TestInfo
        obj.Id = rngData.Cells(lngCounter, 1).Value
        obj.Code = rngData.Cells(lngCounter, 2).Value
        obj.Name = rngData.Cells(lngCounter, 3).Value
        coll.Add obj
    Next lngCounter

    Set GetProducts = coll

End Function