Acces an item in a dictionary with a custom object

2020-04-10 03:48发布

问题:

I've got a problem accessing items in a dictionary in vba.

I've the following dictionary:

Dim CResults as dictionary

I add items:

CResults.add currentkey, result

Currentkey is an object that I created myself from a class called DCRkey

Private loadcase as long
Private csystem as String
Private node as long

and result is another object from a class called DCR:

Private Fs as double
Private C1 as double
Private C2 as double
...

Then I try to access an item using

Dim accesskey as DCRKey
accesskey.loadcase=10
accesskey.node = 2000
accesskey.csystem="Global"
Sheets("Results").cells(i,1).value= CResults(accesskey).C1

That is where I've got the error: runtime error 424 object required

Then I thought maybe the key and the item that I search where not imported, so I decided to display my entire dictionary on an excel worksheet:

Dim testkey as variant
dim i as integer
i=1
with worksheet("Test")
    For each testkey in CResults.keys
        .cells(i,1)=test.node
        .cells(i,2)=test.loadcase
        .cells(i,3)=test.csystem
        .cells(i,4)=Cresults(testkey).C1
        .cells(i,5)=Cresults(testkey).Fs
        if accesskey.loadcase=testkey.loadcase and accesskey.node=testkey.node and accesskey.csystem=testkey.csystem then
            Msgbox "This key is the same as the accesskey"
        End if
        i=i+1
    Next
End with

What I see is:

  1. The key that I was searching earlier exists in the dictionary : visual check on the sheet
  2. The key that I was searching earlier realy exists in the dictionary : "This key is the same as the acceskey" is displayed once
  3. Accessing an item in the dictionary from the for each loop works because C1 and Fs are displayed correctly on the worksheet

Then I thought maybe it is due to the fact that testkey is defined as a variant and not a DCRKey, so I tried that:

dim a as variant
Set a = currentkey
.Cells(i,1) = CResults(a).C1

But it doesn't works and I still got the runtime error 424.

I also did is try:

CResults.exists(accesskey)

It returns false and create a new entry in the dictionary (btw I hate when it does that), with the same key as acceskey and an empty item.

So my question is: why accessing an item using a custom type key works in a for each loop and not in a standalone call. What have I missed? This code is very similar to the code that I wrote but not exactly the same (for you to understand better). Tell me if you think that the real code could help. Thanks for any help.

回答1:

You need to remember that two instances of a class are not the same one, even if all their properties are set to the same values.

Let's consider the example below:

Sub compareSimilarObjects()

    Dim key1 As DCRKey
    Dim key2 As DCRKey

    Set key1 = New DCRKey
    With key1
        .loadcase = 10
        .node = 2000
        .csystem = "Global"
    End With

    Set key2 = New DCRKey
    With key1
        .loadcase = 10
        .node = 2000
        .csystem = "Global"
    End With


    'Debug.Print to check pointer assigne to those variables.
    Debug.Print "Key1: " & ObjPtr(key1)
    Debug.Print "Key2: " & ObjPtr(key2)

End Sub

In this example both objects of DCRKey class have all the properties set to the same values. However, they are not the same object as you can see after the code below run Debug.Prints at the end.

In those Debug.Print VBA built-in function ObjPtr is used. The purpose of this function is to return pointer to the given object. Each instance of object has its own unique pointer, so if the code below printed two different pointers it means those objects are not the same.


Now, let's consider another example:

Sub compareSimilarObjects()
    Dim key1 As DCRKey
    Dim key2 As DCRKey

    Set key1 = New DCRKey
    With key1
        .loadcase = 10
        .node = 2000
        .csystem = "Global"
    End With

    Set key2 = key1


    'Debug.Print to check pointer assigned to those variables.
    Debug.Print "Key1: " & ObjPtr(key1)
    Debug.Print "Key2: " & ObjPtr(key2)
    'Now those pointers should be the same.

End Sub

Here, we assigned a new instance of class DCRKey to the variable key1 and then we assigned the same object to the variable key2. Now ObjPtr should return the same value for both key1 and key2 since this is the same object, it is just assigned to two different variables.


Now, let's go back to dictionaries.

The way how dictionary search for the key of Object type is by its pointer.

So if you want to find an entry in a dictionary that is added with an object as a key, you need to use exactly the same object (not the object having the same properties).

Example:

Sub objectsToDictionaryTest()
    Dim CResults As Dictionary
    Dim accessKey As DCRKey
    Dim key As DCRKey
    Dim value As DCR
    '--------------------------------------------------------------------------------


    Set CResults = New Scripting.Dictionary


    'Let's create an object of [DCRKey] class (it will be used as a key when adding to
    'the dictionary) and an object of [DCR] class (it will be used as a value).
    Set accessKey = New DCRKey
    With accessKey
        .loadcase = 10
        .node = 2000
        .csystem = "Global"
    End With

    Set value = New DCR
    With value
        .C1 = 10
        .C2 = 20
        .Fs = 3
    End With


    'Now, let's add a new entry to the dictionary [CResults]
    CResults.Add accessKey, value


    'Let's create the other object of [DCRKey] that have exactly the same properties
    'as object assigned to the variable [accessKey].
    Set key = New DCRKey
    With key
        .loadcase = 10
        .node = 2000
        .csystem = "Global"
    End With



    'Now, let's check how dictionary is acting when we try to find an entry by [accesKey] and [key].
    Debug.Print "[accessKey] exists: " & CResults.Exists(accessKey)         'it should return True.
    Debug.Print "[key] exists: " & CResults.Exists(key)                     'it should return False.

    Debug.Print "[Value for accessKey]: " & CResults.Item(accessKey).Fs     'it should print 3

    'The line below should cause an run-time error 424: Object required.
    Debug.Print "[Value for key]: " & CResults.Item(key).Fs


End Sub