CODEWITHSUNDEEP
vbaexcel
LetEpsilonBeLessThanZero
LetEpsilonBeLessThanZero

Reputation: 2403

Is there a dictionary-like object which allows me to store an array as the key?

Let's say I have some sort of ListObject in Excel, like so:

KeyCol1     KeyCol2     KeyCol3     ValueCol1
Chevy       Lumina      2003        $75
Chevy       Camaro      2018        $50
Dodge       Charger     2004        $13
Toyota      Camry       2015        $35

I would like to create a dictionary-like object, like so (psuedocode):

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
dict.Add [Chevy, Lumina, 2003], $75
dict.Add [Chevy, Camaro, 2018], $50
dict.Add [Dodge, Charger, 2004], $13
dict.Add [Toyota, Camry, 2015], $35

Essentially, I'd like key, value pairs of [KeyCol1, KeyCol2, KeyCol3], ValueCol1

But dictionaries can't have arrays for keys, so I'm a bit stuck. Is there anything out there that would allow me to get the O(1) performance of a dictionary, but with arrays as "keys"?

Thanks all.

Upvotes: 1

Views: 379

Answers (2)

trincot
trincot

Reputation: 350147

You can just concatenate the array elements to one string and use that as a key. Depending on the actual keys you might need to use a delimiter so it is clear which part of the final string relates to which key.

Just for fun, you can also create a tree of dictionaries. For that you could use these functions:

Sub AddNested(dict As Object, keys As Variant, value As Variant)
    Dim parent As Object
    Dim i As Long
    Dim key As String

    Set parent = dict
    For i = LBound(keys) To UBound(keys) - 1
        key = keys(i)
        If Not parent.Exists(key) Then
            parent.Add key, CreateObject("Scripting.Dictionary")
        End If
        Set parent = parent(key)
    Next
    parent.Add keys(UBound(keys)), value
End Sub

Function GetNested(dict As Object, keys As Variant)
    Dim parent As Object
    Dim i As Long
    Dim key As String

    Set parent = dict
    For i = LBound(keys) To UBound(keys) - 1
        key = keys(i)
        If Not parent.Exists(key) Then
            Exit Function
        End If
        Set parent = parent(key)
    Next
    GetNested = parent(keys(UBound(keys)))
End Function

An example showing how to add to & read from this structure:

Dim dict As Object
Dim i As Long

Set dict = CreateObject("Scripting.Dictionary")
AddNested dict, Array("Chevy", "Lumina", 2003), 75
i = GetNested(dict, Array("Chevy", "Lumina", 2003))
Debug.Print i ' = 75

The advantage here is that individual keys keep their data type in the data structure: e.g. a numeric key remains numeric.

More Generic

If it is necessary to also associate values with partial composite keys, then the above will not suffice. In that case create a real tree where each node can have both a value and child nodes. That can be done by changing the above Sub and Function as follows:

Sub AddNested(dict As Object, keys As Variant, value As Variant)
    Dim parent As Object
    Dim key As String
    Dim children As Object

    Set parent = tree
    For Each key In keys
        If Not parent.Exists("Children") Then
            parent.Add "Children", CreateObject("Scripting.Dictionary")
        End If
        Set children = parent("Children")
        If Not children.Exists(key) Then
            children.Add key, CreateObject("Scripting.Dictionary")
        End If
        Set parent = children(key)
    Next
    If parent.Exists("Value") Then parent.Remove "Value"
    parent.Add "Value", value
End Sub

Function GetNested(dict As Object, keys As Variant)
    Dim parent As Object
    Dim key As String
    Dim children As Object

    Set parent = tree
    For Each key In keys
        If Not parent.Exists("Children") Then Exit Function
        Set children = parent("Children")
        If Not children.Exists(key) Then Exit Function
        Set parent = children(key)
    Next
    GetNested = parent("Value")
End Function

Upvotes: 3

Vityata
Vityata

Reputation: 43575

Concatenate the 3 values to a string, using a ParamArray argument for the concatenation. As mentioned iby @trincot, the idea of a unique delimiter is a good one:

Option Explicit

Sub TestMe()

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    dict.Add addToString("Chevy", "Lumina", "2003"), 75
    dict.Add addToString("Chevy", "Camaro", "2018"), 50
    dict.Add addToString("Dodge", "Charger", "2004"), 13

    If dict.exists("uniqueChevyuniqueLuminaunique2003") Then
        Debug.Print dict("uniqueChevyuniqueLuminaunique2003")
    End If

End Sub

Public Function addToString(ParamArray myVar() As Variant) As String

    Dim cnt     As Long
    Dim val     As Variant
    Dim delim   As String: delim = "unique"

    For cnt = LBound(myVar) To UBound(myVar)
        addToString = addToString & delim & myVar(cnt)
    Next cnt

End Function

Before adding to the dictionary it is considered a good practice to check whether the given key exists. dict.Exists(key).

The idea of ParamArray is that you can give as many parameters as you would like.

Upvotes: 2

Related Questions