Home > Mobile >  Melt/Flatten when Dumping Excel VBA Array
Melt/Flatten when Dumping Excel VBA Array

Time:07-07

I have an array where the number and size of each dimension is unknown. I am trying to make a function that can write out the data in a standardized one dimension/flattened/melted format. I am running into a few issues:

  1. It is not iterating over my array in the sequence I expect, and
  2. It is not writing out the dimensions that I observe when watching the variable, and
  3. When the arrays are initialized via ranges, I have what appears to be some two dimensional index; I can't tell if this is causing me problems

The below function recreates the issue, and the image below shows my desired outcome:

Sub showProblem()
Dim arr(1 To 2) As Variant

ActiveSheet.Range("A1:C4").Formula = "=rand()"
ActiveSheet.Range("A7:C10").Formula = "=rand()"

arr(1) = ActiveSheet.Range("A1:C4").value
arr(2) = ActiveSheet.Range("A7:C10").value

x = melt(arr, 0, "")

End Sub

Function melt(arrs As Variant, depth As Integer, pathstr)

bc = 1 ' branch count
lc = 1 ' leaf count

On Error GoTo leaf
    For Each arrsItem In arrs
        y = melt(arrsItem, depth   1, pathstr & bc & "|")
            bc = bc   1
    Next arrsItem

leaf:
Debug.Print (pathstr & arrs)

End Function
View post on imgur.com

CodePudding user response:

For Each enumerates Arrays by Colum Major Order. (i.e. down the first column, then down the second column etc). You will also be confounded by the fact that the expected dimensions in VBA are the reverse of what you think you see in Excel.

Consider the following Table in excel

1   2   3   4   5
6   7   8   9   10

You might think this is a 5 x 2 array. When Transferred to VBA it is a 2 x 5 array.

If you declare the following 'Dim myArray(1 to 5, 1 to 2)' you will get an array where the first dimension has the range 1 to 5, and the second dimension has the range 1 to 2. Ie. in VBA we specify an array as number of columns by number of rows.

Thus an Excel range transferred to VBA gives a first dimension that represents the number of rows, and a second dimension that represents the number of Columns.

Its straightforward to convert excel arrangement to vba arrangement by using the WorksheetFunction.Transpose. But do remeber to do transpose again when you assign the array back to a range.

CodePudding user response:

Flatten a Jagged Array

Option Explicit

Sub ArrJaggedDataTEST()
    
    Const AddressesList As String = "A1:C4,A7:C10" ' add more!?
    
    ' Define the source array ('sArr') (depends on the number of addresses).
    
    ' Reference the worksheet ('ws').
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve
    ' Using the Split function, write the addresses from the list
    ' to a 1D zero-based array ('Addresses').
    Dim Addresses() As String: Addresses = Split(AddressesList, ",")
    ' Write the upper limit to a variable ('nUpper')
    Dim nUpper As Long: nUpper = UBound(Addresses)
    ' Since the function is simplified to use only 1D arrays,
    ' define the 1D one-based source array which will hold
    ' the values of the ranges in 2D one-based 'range' arrays.
    Dim sArr() As Variant: ReDim sArr(1 To nUpper   1)
    
    ' Populate the ranges ('rg') and the source array.
    
    Dim rg As Range ' Current Range
    Dim Data() As Variant ' Current Range Array
    Dim n As Long ' Current Index in the Addresses Array
    
    For n = 0 To nUpper
        ' Reference the current range.
        Set rg = ws.Range(Addresses(n))
        ' Write sample data to the current range.
        rg.Formula = "=""R""&ROW()&""|""&""C""&COLUMN()"
        rg.Value = rg.Value
        ' Write the data from the current range to the range array.
        If rg.Rows.Count   rg.Columns.Count = 2 Then ' one cell
            ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
        Else ' multiple cells
            Data = rg.Value
        End If
        ' Assign the range array to the current element of the source array.
        sArr(n   1) = Data
    Next n
    
    ' Using the function, write the values from the source
    ' to the destination array.
    Dim dArr() As Variant: dArr = ArrJaggedData(sArr)
    
    ' Print the indexes and values from the destination array.
    For n = 1 To UBound(dArr)
        Debug.Print n, dArr(n)
    Next n
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the values from a one-based jagged array, holding
'               only any number of 2D one-based arrays, in a 1D one-based array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArrJaggedData( _
    ByVal JaggedData As Variant) _
As Variant
    
    Dim nCount As Long: nCount = UBound(JaggedData)
    
    Dim Counts() As Long: ReDim Counts(1 To nCount, 1 To 2)
    
    Dim n As Long
    Dim dCount As Long
    
    For n = 1 To nCount
        Counts(n, 1) = UBound(JaggedData(n), 1)
        Counts(n, 2) = UBound(JaggedData(n), 2)
        dCount = dCount   Counts(n, 1) * Counts(n, 2)
    Next n
    
    Dim dArr() As Variant: ReDim dArr(1 To dCount)
    
    Dim d As Long
    Dim r As Long
    Dim c As Long
    Dim rCount As Long
    Dim cCount As Long
    
    For n = 1 To UBound(JaggedData)
        rCount = Counts(n, 1)
        cCount = Counts(n, 2)
        For r = 1 To rCount
            For c = 1 To cCount
                d = d   1
                dArr(d) = JaggedData(n)(r, c)
            Next c
        Next r
    Next n
    
    ArrJaggedData = dArr

End Function

The Results

 1            R1|C1
 2            R1|C2
 3            R1|C3
 4            R2|C1
 5            R2|C2
 6            R2|C3
 7            R3|C1
 8            R3|C2
 9            R3|C3
 10           R4|C1
 11           R4|C2
 12           R4|C3
 13           R7|C1
 14           R7|C2
 15           R7|C3
 16           R8|C1
 17           R8|C2
 18           R8|C3
 19           R9|C1
 20           R9|C2
 21           R9|C3
 22           R10|C1
 23           R10|C2
 24           R10|C3
  • Related