检索集合中的项目（Excel、VBA）答案

【问题标题】：Retrieve items in collection (Excel, VBA)检索集合中的项目（Excel、VBA）
【发布时间】：2014-02-05 16:43:37
【问题描述】：

我在尝试从我的收藏中检索项目时遇到类型不匹配错误。

我主要想做的是将所有客户收集为集合，并将所有结果放在我的 ListBox 上以进行可视化。我使用类模块的原因是因为 UDT 粘贴了一个错误：“只有在公共对象模块中定义的用户定义类型才能强制转换为变体或传递给后期绑定函数”。所以我开始在类中编写所有属性，但我以前没有真正使用过类，所以这对我来说很新。

我面临另一个问题； .additem-property 限制为 9 列（在 ListBox 上），因此我想为此使用另一种方法。数组是无限的，行源限制为 256 或 255。我希望在 ListBox 上显示 14 列，并且如果以后需要还可以扩展。

ListView 并不是一个真正的选项，因为许多计算机没有集成此参考。

类模块。 "clsCustomers"

Option Explicit

Private cID As String
Private cCustomerName As String
Private cCompanyName As String
Private cFullName As String
Private cCVR As Long
Private cType As String
Private cGroup As String
Private cCountry As String
Private cStreet As String
Private cZipcode As Variant
Private cCity As String
Private cPhoneNum As Long
Private cMobileNum As Long
Private cEmail As String
Private cInvoiceEmail As String
Private cCreationDate As Date
Private cLastChange As Date
Public Property Get customerID() As String
    customerID = cID
End Property
Public Property Let customerID(value As String)
    cID = value
End Property
Public Property Get customerName() As String
    customerName = cCustomerName
End Property
Public Property Let customerName(value As String)
    cCustomerName = value
End Property
Public Property Get customerCompanyName() As String
    customerCompanyName = cCompanyName
End Property
Public Property Let customerCompanyName(value As String)
    cCompanyName = value
End Property
Public Property Get customerFullName() As String
    customerFullName = cFullName
End Property
Public Property Let customerFullName(value As String)
    cFullName = value
End Property
Public Property Get customerCVR() As Long
    customerCVR = cCVR
End Property
Public Property Let customerCVR(value As Long)
    cCVR = value
End Property
Public Property Get customerType() As String
    customerType = cType
End Property
Public Property Let customerType(value As String)
    cType = value
End Property
Public Property Get customerGroup() As String
    customerGroup = cGroup
End Property
Public Property Let customerGroup(value As String)
    cGroup = value
End Property
Public Property Get customerCountry() As String
    customerCountry = cCountry
End Property
Public Property Let customerCountry(value As String)
    cCountry = value
End Property
Public Property Get customerStreet() As String
    customerStreet = cStreet
End Property
Public Property Let customerStreet(value As String)
    cStreet = value
End Property
Public Property Get customerZipcode() As Variant
    customerZipcode = cZipcode
End Property
Public Property Let customerZipcode(value As Variant)
    cZipcode = value
End Property
Public Property Get customerCity() As String
    customerCity = cCity
End Property
Public Property Let customerCity(value As String)
    cCity = value
End Property
Public Property Get customerPhoneNum() As Long
    customerPhoneNum = cPhoneNum
End Property
Public Property Let customerPhoneNum(value As Long)
    cPhoneNum = value
End Property
Public Property Get customerMobileNum() As Long
    customerMobileNum = cMobileNum
End Property
Public Property Let customerMobileNum(value As Long)
    cMobileNum = value
End Property
Public Property Get customerEmail() As String
    customerEmail = cEmail
End Property
Public Property Let customerEmail(value As String)
    cEmail = value
End Property
Public Property Get customerInvoiceEmail() As String
    customerInvoiceEmail = cInvoiceEmail
End Property
Public Property Let customerInvoiceEmail(value As String)
    cInvoiceEmail = value
End Property
Public Property Get customerCreationDate() As Date
    customerCreationDate = cCreationDate
End Property
Public Property Let customerCreationDate(value As Date)
    cCreationDate = value
End Property
Public Property Get customerLastChange() As Date
    customerLastChange = cLastChange
End Property
Public Property Let customerLastChange(value As Date)
    cLastChange = value
End Property

模块。 “mExtendedCustomerDatabase”。在这里，我在工作表（“CustomerDatabase”）中收集我的客户。

Public CustomerCollection As New Collection
Sub CollectAllCustomers()

    Dim tCustomers As clsCustomers
    Dim i As Long
    Dim wks As Worksheet

    Set wks = ThisWorkbook.Worksheets("CustomerDatabase")

    For i = 1 To wks.UsedRange.Rows.Count
        Set tCustomers = New clsCustomers
        With tCustomers
            .customerID = "Kunde" & wks.Cells(i, CustomerDatabase.CustomerNumber).value
            .customerName = wks.Cells(i, CustomerDatabase.InternRef).value
            .customerCompanyName = wks.Cells(i, CustomerDatabase.CompanyName).value
            .customerFullName = wks.Cells(i, CustomerDatabase.FirstName).value & wks.Cells(i, CustomerDatabase.LastName).value
            .customerCVR = wks.Cells(i, CustomerDatabase.CVR).value
            .customerType = wks.Cells(i, CustomerDatabase.customerType).value
            .customerGroup = wks.Cells(i, CustomerDatabase.customerGroup).value
            .customerCountry = wks.Cells(i, CustomerDatabase.Country).value
            .customerStreet = wks.Cells(i, CustomerDatabase.Street).value
            .customerZipcode = wks.Cells(i, CustomerDatabase.Zipcode).value
            .customerCity = wks.Cells(i, CustomerDatabase.City).value
            .customerPhoneNum = wks.Cells(i, CustomerDatabase.PhoneNum).value
            .customerMobileNum = wks.Cells(i, CustomerDatabase.MobileNum).value
            .customerEmail = wks.Cells(i, CustomerDatabase.Email).value
            .customerInvoiceEmail = wks.Cells(i, CustomerDatabase.InvoiceEmail).value
            .customerCreationDate = wks.Cells(i, CustomerDatabase.CreationDate).value
            .customerLastChange = wks.Cells(i, CustomerDatabase.LastChangeDate).value

            CustomerCollection.Add tCustomers, .customerID
        End With
    Next i

End Sub

模块。 “mExtendedCustomerDatabase”。在这里，我想将我的整个收藏添加到我的 ListBox。

Sub FillListBox(sListName As String)

    Dim wks As Worksheet

    Set wks = ThisWorkbook.Worksheets("CustomerDatabase")

    With frm_T1_Kundeoplysninger.Controls.Item(sListName)
        .AddItem CustomerCollection.Item("Kunde1") 'Type Mismatch-error
    End With

End Sub

总结一下。我想要一些关于检索我收藏中所有项目的最简单/最快方法的指南，并将它们传递到我的 ListBox 中。也可以使用其他方法来做到这一点。

【问题讨论】：

VBA 不像其他一些语言平台（例如 NET）那样工作，您可以在其中愉快地将对象分配给 UI 控件。 AddItem() 将字符串作为第一个参数，而不是对象。您将需要通过显式编码各种列值来“手动”填充列表框。
我不确定我是否完全理解您 - 那我应该如何添加收藏的项目？您能否尝试以不同的方式解释它，一个编码示例，或者一个解释它的链接？
查看克里斯的回答：stackoverflow.com/questions/8689812/…
嗯 .List(CustomerCollection) 也不起作用，.addrange (CustomerCollection) 也不起作用。我还是被困住了；我应该如何最全面地填写 ListBox？
您需要按照示例代码进行操作 - 您不能直接分配您的集合：您需要将要显示的字符串转换为数组。

标签： vba excel listbox

【解决方案1】：

我设法解决了。将我的集合转换为数组，并将我的集合设置为输入参数。循环遍历我的整个集合，并将其分配到一个数组中。该问题似乎与 .List-function 有关，仅允许将数组作为变体数据类型。解决了；灵感来自 (http://www.iwebthereforeiam.com/iwebthereforeiam/2004/06/excel-vba-code-to-convert-coll.html)。

Sub FillListBox(sListName As String)

    With frm_T1_Kundeoplysninger.Controls.Item(sListName)
        .List = ConvertCollectionToArray(CustomerCollection)
    End With

Clearing:
    Set CustomerCollection = Nothing

End Sub

Function ConvertCollectionToArray(cCustomers As Collection) As Variant()

    Dim arrCustomers() As Variant: ReDim arrCustomers(0 To cCustomers.Count - 1, 16)
    Dim i As Integer

    With cCustomers
        For i = 1 To .Count
            arrCustomers(i - 1, 0) = .Item(i).customerID
            arrCustomers(i - 1, 1) = .Item(i).customerName
            arrCustomers(i - 1, 2) = .Item(i).customerCompanyName
            arrCustomers(i - 1, 3) = .Item(i).customerFullName
            arrCustomers(i - 1, 4) = .Item(i).customerCVR
            arrCustomers(i - 1, 5) = .Item(i).customerType
            arrCustomers(i - 1, 6) = .Item(i).customerGroup
            arrCustomers(i - 1, 7) = .Item(i).customerCountry
            arrCustomers(i - 1, 8) = .Item(i).customerStreet
            arrCustomers(i - 1, 9) = .Item(i).customerZipcode
            arrCustomers(i - 1, 10) = .Item(i).customerCity
            arrCustomers(i - 1, 11) = .Item(i).customerPhoneNum
            arrCustomers(i - 1, 12) = .Item(i).customerMobileNum
            arrCustomers(i - 1, 13) = .Item(i).customerEmail
            arrCustomers(i - 1, 14) = .Item(i).customerInvoiceEmail
            arrCustomers(i - 1, 15) = .Item(i).customerCreationDate
            arrCustomers(i - 1, 16) = .Item(i).customerLastChange
        Next
    End With

    ConvertCollectionToArray = arrCustomers

End Function

【讨论】：