使用vba中的自定义对象键访问字典中的项目

Question

我在vba中访问字典中的项目时遇到问题.

我有以下字典:

Dim CResults as dictionary

我添加项目:

CResults.add currentkey, result

Currentkey 是我从一个叫做的类创建的对象 DCRkey

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

并且result是来自类的另一个对象DCR:

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

然后我尝试使用访问项目

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

这就是我遇到错误的地方: runtime error 424 object required

然后我想也许我搜索的关键和项目没有导入,所以我决定在excel工作表上显示我的整个字典:

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

我看到的是:

1. 我之前搜索的关键字存在于字典中:在工作表上进行目视检查
2. 我之前搜索的关键字存在于字典中:"This key is the same as the acceskey"显示一次
3. 从for each循环访问字典中的项目是有效的,因为C1和Fs在工作表上正确显示

然后我想也许这是因为testkey被定义为变体而不是a 的事实DCRKey,所以我尝试了:

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

但它不起作用,我仍然得到了runtime error 424.

我也尝试过:

CResults.exists(accesskey)

它返回false并在字典中创建一个新条目(顺便提一下,当它这样做时),使用与acceskey相同的键和一个空项.

所以我的问题是:为什么使用自定义类型密钥访问项目在for each循环中工作而不是在独立调用中工作.我错过了什么？这段代码与我编写的代码非常相似但不完全相同(为了让您更好地理解).如果您认为真正的代码可以提供帮助,请告诉我.谢谢你的帮助.

Answer 1

您需要记住,类的两个实例不是同一个,即使它们的所有属性都设置为相同的值.

我们来看下面的例子:

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

在此示例中,DCRKey类的两个对象都将所有属性设置为相同的值.但是,在下面的代码运行Debug.Prints结束后,它们与您可以看到的对象不同.

在那些使用Debug.PrintVBA内置函数ObjPtr.此函数的目的是返回指向给定对象的指针.对象的每个实例都有自己唯一的指针,因此如果下面的代码打印了两个不同的指针,则表示这些对象不相同.

现在,让我们考虑另一个例子:

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

在这里,我们DCRKey为变量分配了一个新的类实例,key1然后我们将相同的对象分配给变量key2.现在ObjPtr应该为两者返回相同的值key1,key2因为这是同一个对象,所以它只分配给两个不同的变量.

现在,让我们回到词典.

字典搜索Object类型键的方式是指针.

因此,如果要在字典中查找添加了对象作为键的条目,则需要使用完全相同的对象(而不是具有相同属性的对象).

例:

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