将类作为Variantparameter passing时发生运行时错误

当我这样做：

Dim data_set As DataSet Set data_set = New DataSet 'some meaningless operations here list.Add CVar(data_set) 

在list.Add行，我得到一个运行时错误13，争论types不匹配。

这是添加子的标题：

 Public Sub Add(ByRef vItem As Variant, Optional index As Long) 

我在这里错过了什么？

编辑：只是启用所有的错误，并在这段代码失败，现在与运行时错误9：

 Private Function GetListCount() As Long ClearError On Error GoTo Err GetListCount = UBound(mList) - LBound(mList) + 1 Exit Function Err: GetListCount = 0 End Function 

这里是mList定义：

 Private mList() As Variant 

编辑2：这是构造函数：

 '============================== 'Constructor '============================== Public Sub Initialize() Disposed = False ReDim mList(0) End Sub Public Function CreateInstance() As ListClass Dim oNew As New ListClass oNew.Initialize Set CreateInstance = oNew End Function 

EDIT3：在这里请求是整个模块…首先是ListClass

 Private mList() As Variant Private mError As Error Private mDisposed As Boolean '============================== 'Constructor '============================== Public Sub Initialize() Disposed = False ReDim mList(0) End Sub Public Function CreateInstance() As ListClass Dim oNew As New ListClass oNew.Initialize Set CreateInstance = oNew End Function '============================== 'Properties '============================== Public Property Get Items(ByRef index As Long) As Variant Items = GetItemAtIndex(index) End Property Public Property Get Count() As Long Count = GetListCount() End Property Public Property Get GotError() As Boolean If ListError Is Nothing Then GotError = False Else GotError = True End Property Public Property Get ListItems() As Variant() ClearError On Error GoTo Err ListItems = mList Exit Property Err: ListError = Err End Property Public Property Get ListError() As Error ListError = mError End Property Private Property Let ListError(ByRef vError As Error) Set mError = vError End Property Public Property Get Disposed() As Boolean Disposed = mDisposed End Property Private Property Let Disposed(ByRef vValue As Boolean) mDisposed = vValue End Property Public Property Get ToArray() ToArray = mList End Property '============================== 'Public Methods '============================== Public Sub Remove(ByRef vItem As Variant) DeleteElement (vItem) End Sub Public Sub RemoveAtIndex(ByRef index As Long) DeleteElementAt (index) End Sub Public Sub Sort() BubbleSort (mList) End Sub Public Sub Clear() Erase mList End Sub Public Function Find(ByRef vItem As Variant) As Long Find = FindItem(vItem) End Function Public Sub Dispose() ResetError Clear Disposed = True End Sub Public Sub ResetError() ClearError End Sub Public Function LastIndexOf(ByRef vItem As Variant) LastIndexOf = GetLastIndexOf(vItem) End Function Public Function IndexOf(ByRef vItem As Variant) IndexOf = FindItem(vItem) End Function Public Sub Reverse() ReverseList End Sub Public Function Exists(vItem As Variant) Exists = ItemExists(vItem) End Function Public Sub Add(ByRef vItem As Variant, Optional index As Long) If index > 0 Then AddItemAt index, vItem Else AddItem vItem End If End Sub Public Function Contains(ByRef vItem As Variant) Contains = Exists(vItem) End Function Public Function Copy() As ListClass Set Copy = GetCopy End Function Public Sub RemoveAll() Clear End Sub '============================== 'Private Methods '============================== Private Sub ClearError() Set mError = Nothing End Sub Private Function GetListCount() As Long ClearError On Error GoTo Err GetListCount = UBound(mList) - LBound(mList) + 1 'and error happens here Exit Function Err: GetListCount = 0 End Function Private Function GetItemAtIndex(ByRef index As Long) As Variant ClearError On Error GoTo Err GetItemAtIndex = mList(index) Exit Function Err: ListError = Err GetItemAtIndex = Nothing End Function Private Sub AddItemAt(index As Long, vItem As Variant) ClearError On Error GoTo Err Dim ar() As Variant Dim i As Integer i = Count ReDim ar(i) For a = 0 To index - 1 ar(a) = mList(a) Next ar(index) = vItem For a = index + 1 To i ar(a) = mList(a - 1) Next mList = ar Exit Sub Err: ListError = Err End Sub Private Sub BubbleSort(ByVal vArray As Variant) ClearError On Error GoTo Err Dim i As Long Dim iMin As Long Dim iMax As Long Dim vSwap As Variant Dim swapped As Boolean iMin = LBound(vArray) iMax = UBound(vArray) - 1 Do swapped = False For i = iMin To iMax If vArray(i) > vArray(i + 1) Then vSwap = vArray(i) vArray(i) = vArray(i + 1) vArray(i + 1) = vSwap swapped = True End If Next iMax = iMax - 1 Loop Until Not swapped mList = vArray Erase vArray Exit Sub Err: ListError = Err End Sub Private Sub DeleteElementAt(index As Integer) ClearError On Error GoTo Err Dim i As Integer For i = index + 1 To Count - 1 mList(i - 1) = mList(i) Next ReDim Preserve mList(Count - 2) Exit Sub Err: ListError = Err End Sub Private Sub DeleteElement(ByRef vItem As Variant) ClearError On Error GoTo Err DeleteElementAt (FindItem(vItem)) Exit Sub Err: ListError = Err End Sub Private Sub AddItem(vItem As Variant) ClearError On Error GoTo Err Dim i As Long i = Count ReDim Preserve mList(i) mList(i) = vItem Exit Sub Err: ListError = Err End Sub Private Function FindItem(vItem As Variant) As Long ClearError On Error GoTo Err FindItem = -1 For i = 0 To Count - 1 If mList(i) = vItem Then FindItem = i Exit For End If Next i Exit Function Err: ListError = Err FindItem = -1 End Function Private Function GetLastIndexOf(vItem As Variant) As Long ClearError On Error GoTo Err GetLastIndexOf = -1 Dim i As Long For i = Count - 1 To 0 Step -1 If mList(i) = vItem Then GetLastIndexOf = i Exit Function End If Next i Exit Function Err: ListError = Err GetLastIndexOf = -1 End Function Private Sub ReverseList() ClearError On Error GoTo Err Dim ar() As Variant Dim i As Long Dim j As Long If Count = 0 Then Exit Sub i = Count - 1 j = i ReDim ar(i) For a = 0 To i ar(a) = mList(j) j = j - 1 Next a mList = ar Erase ar Exit Sub Err: ListError = Err End Sub Private Function ItemExists(vItem As Variant) As Boolean If FindItem(vItem) > -1 Then ItemExists = True Else ItemExists = False End If End Function Private Function GetCopy() As ListClass Dim list As New ListClass Set list = list.CreateInstance For i = 0 To Count - 1 list.Add mList(i) Next i Set GetCopy = list i = GetCopy.Count End Function 

而现在的错误正在发生的function…

 Function ReadData() As ListClass 'instanteate list Dim list As ListClass Set list = New ListClass 'get sheets Dim sheet As Worksheet Set sheet = Sheets("Data") Dim dataSheet As Worksheet Set dataSheet = Sheets("DataSet") 'read lines and store them on list Dim i As Integer i = 2 Do While sheet.Cells(i, 1) <> "" Dim data_set As DataSet Set data_set = New DataSet data_set.entry_spread = CSng(dataSheet.Cells(i, 7).Value) data_set.result = CSng(dataSheet.Cells(i, 12).Value) data_set.lot = CInt(dataSheet.Cells(i, 13).Value) data_set.win = IIf(UCase(dataSheet.Cells(i, 15).Value) = "YES", True, False) data_set.group = CInt(dataSheet.Cells(i, 20).Value) data_set.atr = CSng(dataSheet.Cells(i, 21).Value) data_set.pdr = CSng(dataSheet.Cells(i, 22).Value) data_set.ir = CSng(dataSheet.Cells(i, 23).Value) data_set.fib = dataSheet.Cells(i, 24).Value data_set.slipage = CSng(dataSheet.Cells(i, 25).Value) data_set.slipread = CSng(dataSheet.Cells(i, 26).Value) list.Add CVar(data_set) 'error happens here... i = i + 1 Loop ReadData = list End Function 

Answer 1

您不需要创build自己的构造函数，因为您不传递任何参数 – 所以您可以使用Class_Initialize事件。 replace这个：

 '============================== 'Constructor '============================== Public Sub Initialize() Disposed = False ReDim mList(0) End Sub Public Function CreateInstance() As ListClass Dim oNew As New ListClass oNew.Initialize Set CreateInstance = oNew End Function 

有了这个：

 Private Sub Class_Initialize() Disposed = False ReDim mList(0) End Sub 

并记得从GetCopy函数中删除这一行：

 Set list = list.CreateInstance 

编辑：忘记提及，因为你传递的对象，你需要使用Set时，将其分配给数组mList 。