Transpose a multi dimensional array

G.M

I wrote some code that should fill an multi dimensional array with values. Initial the array has the size 1000x1000 but at the end it it should be redimed to the needed (actually used) size.for this I use the code:

ReDim Preserve MultiArrPaerchen(LBound(MultiArrPaerchen, 1) To UBound(MultiArrPaerchen, 1), LBound(MultiArrPaerchen, 2) To n)
Application.WorksheetFunction.Transpose (MultiArrPaerchen)
ReDim Preserve MultiArrPaerchen(LBound(MultiArrPaerchen, 1) To UBound(MultiArrPaerchen, 1), LBound(MultiArrPaerchen, 2) To m)
Application.WorksheetFunction.Transpose (MultiArrPaerchen)

What happen is that the size of the array changes from 1000x1000 to 1000x120 (correct value) and the to 1000x18. So the first transpose doesnt do anything if I see this correctly since the dimensions of the array arent switched. But the code looks right doesn't it?

user10798192

I believe that I may have provided erroneous information in a comment made to a previous question. Application.Transpose returns the transposed array like any function. It doesn't process it 'in place' like a ByRef parameter.

'NOT this was
Application.WorksheetFunction.Transpose (MultiArrPaerchen)
'Do it THIS WAY
MultiArrPaerchen = Application.WorksheetFunction.Transpose(MultiArrPaerchen)

FWIW, the space auto-magically added should have been seen as an indication that the syntax was wonky.

The first ReDim adjusts the second rank; the second rank is the only one that can be adjusted when sing the Preserve argument with ReDim.

The first Transpose flips the first and second rank. Now you can ReDim the original first rank which is not the last rank.

The second ReDim adjusts the last rank (which was originally the first).

The second Transpose takes the flipped array and returns it to its original orientation with the new dimensions in both ranks.

Sub test()

    Dim MultiArrPaerchen As Variant, m As Long, n As Long

    m = 1000
    n = 1000

    ReDim MultiArrPaerchen(1 To m, 1 To n)
    Debug.Print LBound(MultiArrPaerchen, 1) & " to " & UBound(MultiArrPaerchen, 1) & ", " & _
                LBound(MultiArrPaerchen, 2) & " to " & UBound(MultiArrPaerchen, 2)
    'results: 1 to 1000, 1 to 1000

    'UBounbds for 1 to 18, 1 to 120
    m = 18
    n = 120

    ReDim Preserve MultiArrPaerchen(LBound(MultiArrPaerchen, 1) To UBound(MultiArrPaerchen, 1), _
                                    LBound(MultiArrPaerchen, 2) To n)
    Debug.Print LBound(MultiArrPaerchen, 1) & " to " & UBound(MultiArrPaerchen, 1) & ", " & _
                LBound(MultiArrPaerchen, 2) & " to " & UBound(MultiArrPaerchen, 2)
    'results: 1 to 1000, 1 to 120

    MultiArrPaerchen = Application.Transpose(MultiArrPaerchen)
    Debug.Print LBound(MultiArrPaerchen, 1) & " to " & UBound(MultiArrPaerchen, 1) & ", " & _
                LBound(MultiArrPaerchen, 2) & " to " & UBound(MultiArrPaerchen, 2)
    'results: 120, 1 to 1000

    ReDim Preserve MultiArrPaerchen(LBound(MultiArrPaerchen, 1) To UBound(MultiArrPaerchen, 1), LBound(MultiArrPaerchen, 2) To m)
    Debug.Print LBound(MultiArrPaerchen, 1) & " to " & UBound(MultiArrPaerchen, 1) & ", " & _
                LBound(MultiArrPaerchen, 2) & " to " & UBound(MultiArrPaerchen, 2)
    'results: 1 to 120, 1 to 18

    MultiArrPaerchen = Application.Transpose(MultiArrPaerchen)
    Debug.Print LBound(MultiArrPaerchen, 1) & " to " & UBound(MultiArrPaerchen, 1) & ", " & _
                LBound(MultiArrPaerchen, 2) & " to " & UBound(MultiArrPaerchen, 2)
    'results: 1 to 18, 1 to 120
End Sub

Collected from the Internet

Please contact [email protected] to delete if infringement.

edited at
0

Comments

0 comments
Login to comment

Related