VBA – Transpor Matriz

Este tutorial ensinará você a transpor uma matriz usando o VBA.

Transpor Matriz

Essa função fará a transposição de uma matriz bidimensional:

Function TransporMatriz(MinhaMatriz 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
    
 'Obter limites superior e inferior
 maxX = UBound(MinhaMatriz, 1)
 minX = LBound(MinhaMatriz, 1)
 maxY = UBound(MinhaMatriz, 2)
 minY = LBound(MinhaMatriz, 2)
    
 'Criar nova matriz temp
 ReDim tempArr(minY To maxY, minX To maxX)
    
 'Transpor a matriz
 For x = minX To maxX
     For y = minY To maxY
         tempArr(y, x) = MinhaMatriz(x, y)
     Next y
 Next x
    
 'Matriz de saída
 TransporMatriz = tempArr
    
End Function

Sub TesteTransporMatriz()
 Dim testeMatriz(1 To 3, 1 To 2) As Variant
 Dim saidaMatriz As Variant
    
 'Atribuir valores à matriz
 testeMatriz(1, 1) = "Steve"
 testeMatriz(1, 2) = "Johnson"
 testeMatriz(2, 1) = "Ryan"
 testeMatriz(2, 2) = "Johnson"
 testeMatriz(3, 1) = "Andrew"
 testeMatriz(3, 2) = "Scott"
    
 'Chamar a função de transposição
 saidaMatriz = TransporMatriz(testeMatriz)
    
 'Testar saída
 MsgBox saidaMatriz(2, 1)

End Sub

Para testar essa função, chame o procedimento TesteTransporMatriz: aqui é criada uma matriz inicial testeMatriz e saidaMatriz é a matriz transposta final.

WorksheetFunction.Transpose

Em vez disso, talvez você queira transpor uma matriz para o Excel. Para isso, você pode usar a função de planilha Transpor do Excel.

Esse procedimento transporá uma matriz 2D para um intervalo do Excel usando WorksheetFunction.Transpose:

Sub TesteTranspor_WorksheetFunction()
 Dim maxX As Long, minX As Long
 Dim maxY As Long, minY As Long
    
 'Criar matriz e atribuir valores
 Dim MinhaMatriz(1 To 3, 1 To 2) As Variant
    
 MinhaMatriz(1, 1) = "Steve"
 MinhaMatriz(1, 2) = "Johnson"
 MinhaMatriz(2, 1) = "Ryan"
 MinhaMatriz(2, 2) = "Johnson"
 MinhaMatriz(3, 1) = "Andrew"
 MinhaMatriz(3, 2) = "Scott"
    
 'Obter limites superior e inferior
 maxX = UBound(MinhaMatriz, 1)
 minX = LBound(MinhaMatriz, 1)
 maxY = UBound(MinhaMatriz, 2)
 minY = LBound(MinhaMatriz, 2)
    
 'Transpor matriz para o Excel
 Range("a1").Resize(maxY - minY + 1, maxX - minX + 1).Value = _
 Application.WorksheetFunction.Transpose(MinhaMatriz)

End Sub