检索集合中的项目(Excel,VBA)

时间:2014-02-05 16:43:38

标签: excel vba excel-vba listbox

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

我主要想做的是收集所有客户作为集合,并将我的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&#34 ;.在这里,我在工作表中收集了我的客户(" 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&#34 ;.在这里,我想将我的整个集合添加到我的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中。替代方法也可以这样做。

1 个答案:

答案 0 :(得分:0)

我设法解决它。将我的集合转换为数组,并将我的集合设置为inputparameter。循环遍历我的整个集合,并将其分配到一个数组中。这个问题似乎与.List-function有关,只允许数组作为variant-datatype。它解决了;灵感来自(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