Class 我的VBA代码中有错误。内部字典中的函数Show将计数增加1
我创建了两个类。一个具有“double”类型项的内部Dict和一个具有内部Dict类型项的外部Dict。这两个类都有一个显示过程来打印数据。我创建了一个测试过程来验证这两个类。内部记录可以,但外部记录有一个问题:当跟踪进入显示功能时,计数增加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
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使用空键创建空项 代码从不计算不存在的元素,但在监视窗口中,我有一个表达式正在查看字典类型的外部变量。进入模块显示时,观察表达式将添加一项 我刚擦了看电视的窗户