Home > Software engineering >  Convert collection of collections to range
Convert collection of collections to range

Time:01-04

Here is my Excel VBA function

Function make_range()
    Dim the_json As String
    the_json = "[[1,2,3][4,5,6]]"
    Set the_collection = JsonConverter.ParseJson(the_json)
    make_range = 'question: how to convert the collection to range?
End Function

The function generate a collection of collections by using the JsonConverter.ParseJson

my question is: how to convert it to a a vba range?

CodePudding user response:

Your posted JSON is invalid (missing a comma between the two inner arrays). You cannot create a range from scratch, only refer to an existing one on a worksheet.

Maybe you want your function to return a 2D array?

Sub TestJsonToArray()
    Dim arr
    arr = JsonToArray("[[1,2,3],[4,5,6],[7,8,9]]")
    ActiveSheet.Range("B4").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub


Function JsonToArray(json As String)
    Dim col As Collection, arr, r As Long, c As Long, nc As Long
    Set col = JsonConverter.ParseJson(json)
    nc = col(1).Count 'assumes all inner collections are the same size...
    ReDim arr(1 To col.Count, 1 To nc)
    For r = 1 To col.Count
        For c = 1 To nc
            arr(r, c) = col(r)(c)
        Next c
    Next r
    JsonToArray = arr
End Function

CodePudding user response:

Write a Collection of Collections to a Range

  • In this example, each inner collection is written to cells of a row.
Option Explicit

Sub CollOfCollsToRange()

    Const dwsName As String = "Sheet1"
    Const dfCellAddress As String = "A1"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim dws As Worksheet: Set dws = wb.Worksheets(dwsName)
    Dim dCell As Range: Set dCell = dws.Range(dfCellAddress)
    
    Dim Json As String: Json = "[[1,2,3][4,5,6]]"
    Dim Coll As Collection: Set Coll = JsonConverter.ParseJson(Json)
    Dim Arr As Variant: Arr = JagCollOfColls(Coll)
    
    Dim r As Long
    For r = 1 To UBound(Arr)
        dCell.Resize(, UBound(Arr(r))).Value = Arr(r)
        Set dCell = dCell.Offset(1)
    Next r
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the collections of a collection in arrays of an array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function JagCollOfColls( _
    ByVal Coll As Collection) _
As Variant
    
    Dim oArr As Variant: ReDim oArr(1 To Coll.Count)
    
    Dim iArr As Variant, oItem As Variant, iItem As Variant
    Dim o As Long, i As Long
    
    For Each oItem In Coll
        o = o   1
        i = 0
        ReDim iArr(1 To oItem.Count)
        For Each iItem In oItem
            i = i   1
            iArr(i) = iItem
        Next iItem
        oArr(o) = iArr
    Next oItem

    JagCollOfColls = oArr

End Function
  •  Tags:  
  • Related