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:
- It is not iterating over my array in the sequence I expect, and
- It is not writing out the dimensions that I observe when watching the variable, and
- 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