Class 我的VBA代码中有错误。内部字典中的函数Show将计数增加1

Class 我的VBA代码中有错误。内部字典中的函数Show将计数增加1,class,excel,dictionary,vba,Class,Excel,Dictionary,Vba,我创建了两个类。一个具有“double”类型项的内部Dict和一个具有内部Dict类型项的外部Dict。这两个类都有一个显示过程来打印数据。我创建了一个测试过程来验证这两个类。内部记录可以,但外部记录有一个问题:当跟踪进入显示功能时,计数增加1。它使用空键创建一个新项。这在尝试打印新项目时会生成错误 Class Module IntDict 'private Attributes Private pInternalDict As Scripting.Dictionary 'Class

我创建了两个类。一个具有“double”类型项的内部Dict和一个具有内部Dict类型项的外部Dict。这两个类都有一个显示过程来打印数据。我创建了一个测试过程来验证这两个类。内部记录可以,但外部记录有一个问题:当跟踪进入显示功能时,计数增加1。它使用空键创建一个新项。这在尝试打印新项目时会生成错误

Class Module IntDict  
'private Attributes  
Private pInternalDict As Scripting.Dictionary

'Class Initialize/Terminate methods  
Private Sub Class_Initialize()  
Set pInternalDict = New Scripting.Dictionary  
End Sub

Private Sub Class_Terminate()  
Set pInternalDict = Nothing  
End Sub

'Add/Count/Items/Item/Remove/Remove All Methods  
Public Function Add(Key As Variant, Item As Double)  
pInternalDict.Add Key:=Key, Item:=Item  
End Function

Public Function Update(Key As Variant, Item As Double)  
If pInternalDict.Exists(Key) Then  
    pInternalDict.Item(Key) = pInternalDict.Item(Key) + Item  
Else  
    pInternalDict.Add Key:=Key, Item:=Item  
End If  
End Function

Public Property Get Count() As Long  
Count = pInternalDict.Count  
End Property

Public Property Get Items() As Scripting.Dictionary  
Set Items = pInternalDict  
End Property

Public Property Get Item(vItem As Variant) As Double  
Item = pInternalDict.Item(vItem)  
End Property

Public Function Exists(vItem As Variant) As Boolean  
Exists = pRentas.Exists(vItem)  
End Function

Public Sub Show()  
Dim vKey As Variant

For Each vKey In pInternalDict.Keys  
    Debug.Print vKey & "|" & pInternalDict.Item(vKey)  
Next  
End Sub

Class Module ExtDict  
'private Attributes  
Private pExternalDict As Scripting.Dictionary  

'Class Initialize/Terminate methods  
Private Sub Class_Initialize()   
Set pExternalDict = New Scripting.Dictionary  
End Sub

Private Sub Class_Terminate()  
Set pExternalDict = Nothing  
End Sub

'Add/Count/Items/Item/Remove/Remove All Methods  
Public Function Add(Key As Variant, Item As CInternalDict)  
pExternalDict.Add Key:=Key, Item:=Item  
End Function

Public Function Update(ExternalKey As Variant, InternalKey As Variant,   Item As Double)  
Dim newIntDict As CInternalDict  

If pExternalDict.Exists(ExternalKey) Then  
    With pExternalDict.Item(ExternalKey)  
        Call .Update(InternalKey, Item)  
    End With  
Else  
    Set newIntDict = New CInternalDict  
    newIntDict.Add Key:=InternalKey, Item:=Item  
    pExternalDict.Add Key:=ExternalKey, Item:=newIntDict  
End If  
End Function

Public Property Get Count() As Long  
Count = pExternalDict.Count  
End Property

Public Property Get Items() As Scripting.Dictionary  
Set Items = pExternalDict  
End Property

Public Property Get Item(vItem As Variant) As CRentasCasa  
Item = pExternalDict.Item(vItem)  
End Property

Public Function Exists(vItem As Variant) As Boolean  
Exists = pExternalDict.Exists(vItem)  
End Function

Public Sub Show()  
Dim vKey As Variant  
Dim dItem As CInternalDict  

For Each vKey In pExternalDict.Keys  
    Debug.Print vKey 'Print external key  
    Set dItem = pExternalDict.Item(vKey)  
    dItem.Show 'Show Internal Dict  
Next  
End Sub

=========================
'Externals procedures

Sub Test_InternalDict() 'It's OK  
Dim myIntDict As CInternalDict  

Set myIntDict = New CInternalDict  
    myIntDict.Update "IntBox1", 1500  
    myIntDict.Update "IntBox2", 1800  
    myIntDict.Update "IntBox1", 200  
    myIntDict.Update "IntBox2", 100  
    myIntDict.Update "IntBox1", 100  
    myIntDict.Update "IntBox3", 1500  
    myIntDict.Update "IntBox4", 1900  
    myIntDict.Show  
Set myIntDict = Nothing  
End Sub

'Creates the ExternalDict in the right way but show call has a bad behavior  
Sub Test_ExternalDict()   
Dim myExtDict As CExternalDict

Set myExtDict = New CExternalDict  
    myExtDict.Update "ExtBox1", 6, 1500  
    myExtDict.Update "ExtBox1", 8, 1800  
    myExtDict.Update "ExtBox2", 5, 100  
    myExtDict.Update "ExtBox3", 7, 1900  
    myExtDict.Update "ExtBox1", 7, 1600  
    myExtDict.Update "ExtBox2", 8, 1900  
    myExtDict.Update "ExtBox3", 4, 100  
    myExtDict.Update "ExtBox1", 7, 300  
    myExtDict.Update "ExtBox2", 5, 1400  
    myExtDict.Update "ExtBox3", 4, 1500  
    myExtDict.Update "ExtBox1", 6, 200  
    myExtDict.Update "ExtBox3", 5, 200  
    myExtDict.Update "ExtBox3", 5, 1800  
    myExtDict.Update "ExtBox3", 7, -100  
    myExtDict.Show 'ERROR. Add an Item when enter in the Show Function  
Set myExtDict = Nothing
End Sub`

“有什么线索吗?”

解决了。代码我是对的

Vba字典在访问不存在的项时出现问题:Vba使用空键创建空项

代码从不计算不存在的元素,但在监视窗口中,我有一个表达式正在查看字典类型的外部变量。进入模块显示时,观察表达式将添加一项

我刚擦了看电视的窗户