Excel data to a dictionary using VBA-CodePudding

For example, I have some data in an excel sheet 'MySheet' as follows:

sepal	petal
5	11
4	12
3	13

I need to convert these data into a dictionary-like follows after calling a VBA function named ex_dict ():

=ex_dict(A1:B4)
{"sepal": [5,4,3], "petal": [11,12,13]}

CodePudding user response：

Columns to String

Function ex_dict(ByVal rg As Range) As String
    
    Dim rCount As Long: rCount = rg.Rows.Count
    If rCount < 2 Then Exit Function
    
    ex_dict = "{"
    
    Dim crg As Range
    Dim r As Long
    
    For Each crg In rg.Columns
        ex_dict = ex_dict & """" & crg.Cells(1).Value & """: ["
        For r = 2 To rCount
            ex_dict = ex_dict & crg.Cells(r).Value & ","
        Next r
        ex_dict = Left(ex_dict, Len(ex_dict) - 1) & "], "
    Next crg
    
    ex_dict = Left(ex_dict, Len(ex_dict) - 2) & "}"

End Function

CodePudding user response：

Using the Dictionary Object.

Sub Example()
    'Create a Dictionary object
    Dim sepal As Object
    Set sepal = CreateObject("Scripting.Dictionary")
    
    'Loop through the table
    Dim Cell As Range
    For Each Cell In Range("A2:A5")
        'Add unique entries to the dictionary
        If Not sepal.exists(Cell.Value) Then
            'Add cell value as the Key & the adjacent value as the Item.
            sepal.Add Cell.Value, Cell.Offset(, 1).Value
        End If
    Next
    
    Debug.Print sepal(4) 'returns 12
    Debug.Print sepal(3) 'returns 13
End Sub

After building the dictionary, sepal.Keys returns the array [5,4,3] and sepal.Items returns the array [11,12,13].

CodePudding user response：

Please, use the next function:

Function ex_dict(rng As Range) As String
   Dim dict As Object, arrKeys, arrItems, prefK As String, prefIt As String
   Dim i As Long
   
   Set dict = CreateObject("Scripting.Dictionary")
   For i = 1 To rng.rows.count
        dict(rng.cells(i, 1)) = rng.cells(i, 2)
   Next i
   arrKeys = dict.Keys: arrItems = dict.items
   prefK = "{""" & arrKeys(0) & """: ["
   prefIt = """" & arrItems(0) & """: ["
   arrKeys(0) = prefK: arrItems(0) = prefIt
   arrKeys = filter(arrKeys, prefK, False)
   arrItems = filter(arrItems, prefIt, False)
   ex_dict = prefK & Join(arrKeys, ",") & "], " & prefIt & Join(arrItems, ",") & "]}"
End Function

It can be tested with a simple Sub:

Sub tesTex_dict()
    Debug.Print ex_dict(Range("A1:B4"))
End Sub

or call it as UDF (User Defined Function) from a cell as:

 =ex_dict(A1:B4)

CodePudding user response：

I didn't get the issue ?

Using the function cells() in VBA should allow you to pick up the values by giving the cell coordinates. One or two for...next loop should be also necessary to read all the datas.