VBA Transponer Array

Este tutorial te enseñará cómo transponer un array usando VBA.

Transponer Array

Esta función transpondrá un array de 2 dimensiones:

Function TransposeArray(MyArray As Variant) As Variant
    Dim x As Long, y As Long
    Dim maxX As Long, minX As Long
    Dim maxY As Long, minY As Long
    
    Dim tempArr As Variant
    
    'Obtener límites superior e inferior
    maxX = UBound(MyArray, 1)
    minX = LBound(MyArray, 1)
    maxY = UBound(MyArray, 2)
    minY = LBound(MyArray, 2)
    
    'Crear nueva array temporal
    ReDim tempArr(minY To maxY, minX To maxX)
    
    'Transponer el Array
    For x = minX To maxX
        For y = minY To maxY
            tempArr(y, x) = MyArray(x, y)
        Next y
    Next x
    
    'Array Resultante
    TransposeArray = tempArr
    
End Function

Sub TestTransposeArray()
    Dim testArr(1 To 3, 1 To 2) As Variant
    Dim outputArr As Variant
    
    'Asignar valores al Array
    testArr(1, 1) = "Steve"
    testArr(1, 2) = "Johnson"
    testArr(2, 1) = "Ryan"
    testArr(2, 2) = "Johnson"
    testArr(3, 1) = "Andrew"
    testArr(3, 2) = "Scott"
    
    'Llamar Función "TransposeArray"
    outputArr = TransposeArray(testArr)
    
    'Resultado de la prueba
    MsgBox outputArr(2, 1)

End Sub

Para probar esta función, llama al procedimiento TestTransposeArray: aquí se crea un array inicial testArr y outputArr es el array transpuesto final.

WorksheetFunction.Transpose

En cambio, puede que quieras transponer un array a Excel. Para ello, puede utilizar la función Excel WorksheetFunction.Transpose.

Este procedimiento transpondrá un array 2D a un rango de Excel utilizando WorksheetFunction.Transpose:

Sub TestTransposeArray_Worksheetfx()
    Dim maxX As Long, minX As Long
    Dim maxY As Long, minY As Long
    
    'Crear array y asignar valores
    Dim MyArray(1 To 3, 1 To 2) As Variant
    
    MyArray(1, 1) = "Steve"
    MyArray(1, 2) = "Johnson"
    MyArray(2, 1) = "Ryan"
    MyArray(2, 2) = "Johnson"
    MyArray(3, 1) = "Andrew"
    MyArray(3, 2) = "Scott"
    
    'Obtener límites superior e inferior
    maxX = UBound(MyArray, 1)
    minX = LBound(MyArray, 1)
    maxY = UBound(MyArray, 2)
    minY = LBound(MyArray, 2)
    
    'Transponer array a Excel
    Range("a1").Resize(maxY - minY + 1, maxX - minX + 1).Value = _
      Application.WorksheetFunction.Transpose(MyArray)

End Sub