Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
transpose matrices
For a matrix of that size, Application.Transpose(myMatrix) will return
the transpose in xl2000 if myArray is a Variant() type array of about 5400 elements or less. =ArrayTranspose(myArray) will work where ArrayTranspose is: Function ArrayTranspose(InputArray) 'This function returns the transpose of 'the input array or range; it is designed 'to avoid the limitation on the number of 'array elements and type of array that the 'worksheet TRANSPOSE Function has. 'Declare the variables Dim outputArrayTranspose As Variant, arr, p As Integer Dim i As Long, j As Long 'Check to confirm that the input array 'is an array or multicell range If IsArray(InputArray) Then 'If so, convert an input range to a 'true array arr = InputArray 'Load the number of dimensions of 'the input array to a variable On Error Resume Next 'Loop until an error occurs i = 1 Do z = UBound(arr, i) i = i + 1 Loop While Err = 0 'Reset the error value for use with other procedures Err = 0 'Return the number of dimensions p = i - 2 End If If Not IsArray(InputArray) Or p 2 Then Msg = "#ERROR! The function accepts only multi-cell ranges and 1D or 2D arrays." If TypeOf Application.Caller Is Range Then ArrayTranspose = Msg Else MsgBox Msg, 16 End If Exit Function End If 'Load the output array from a one- 'dimensional input array If p = 1 Then Select Case TypeName(arr) Case "Object()" ReDim outputArrayTranspose(LBound(arr) To UBound(arr), LBound(arr) To LBound(arr)) As Object For i = LBound(outputArrayTranspose) To UBound(outputArrayTranspose) Set outputArrayTranspose(i, LBound(outputArrayTranspose)) = arr(i) Next Case "Boolean()" ReDim outputArrayTranspose(LBound(arr) To UBound(arr), LBound(arr) To LBound(arr)) As Boolean Case "Byte()" ReDim outputArrayTranspose(LBound(arr) To UBound(arr), LBound(arr) To LBound(arr)) As Byte Case "Currency()" ReDim outputArrayTranspose(LBound(arr) To UBound(arr), LBound(arr) To LBound(arr)) As Currency Case "Date()" ReDim outputArrayTranspose(LBound(arr) To UBound(arr), LBound(arr) To LBound(arr)) As Date Case "Double()" ReDim outputArrayTranspose(LBound(arr) To UBound(arr), LBound(arr) To LBound(arr)) As Double Case "Integer()" ReDim outputArrayTranspose(LBound(arr) To UBound(arr), LBound(arr) To LBound(arr)) As Integer Case "Long()" ReDim outputArrayTranspose(LBound(arr) To UBound(arr), LBound(arr) To LBound(arr)) As Long Case "Single()" ReDim outputArrayTranspose(LBound(arr) To UBound(arr), LBound(arr) To LBound(arr)) As Single Case "String()" ReDim outputArrayTranspose(LBound(arr, 2) To UBound(arr, 2), LBound(arr, 1) To UBound(arr, 1)) As String Case "Variant()" ReDim outputArrayTranspose(LBound(arr) To UBound(arr), LBound(arr) To LBound(arr)) As Variant Case Else Msg = "#ERROR! Only built-in types of arrays are supported." If TypeOf Application.Caller Is Range Then ArrayTranspose = Msg Else MsgBox Msg, 16 End If Exit Function End Select If TypeName(arr) < "Object()" Then For i = LBound(outputArrayTranspose) To UBound(outputArrayTranspose) outputArrayTranspose(i, LBound(outputArrayTranspose)) = arr(i) Next End If 'Or load the output array from a two- 'dimensional input array or range ElseIf p = 2 Then Select Case TypeName(arr) Case "Object()" ReDim outputArrayTranspose(LBound(arr, 2) To UBound(arr, 2), _ LBound(arr) To UBound(arr)) As Object For i = LBound(outputArrayTranspose) To _ UBound(outputArrayTranspose) For j = LBound(outputArrayTranspose, 2) To _ UBound(outputArrayTranspose, 2) Set outputArrayTranspose(i, j) = arr(j, i) Next Next Case "Boolean()" ReDim outputArrayTranspose(LBound(arr, 2) To UBound(arr, 2), _ LBound(arr) To UBound(arr)) As Boolean Case "Byte()" ReDim outputArrayTranspose(LBound(arr, 2) To UBound(arr, 2), _ LBound(arr) To UBound(arr)) As Byte Case "Currency()" ReDim outputArrayTranspose(LBound(arr, 2) To UBound(arr, 2), _ LBound(arr) To UBound(arr)) As Currency Case "Date()" ReDim outputArrayTranspose(LBound(arr, 2) To UBound(arr, 2), _ LBound(arr) To UBound(arr)) As Date Case "Double()" ReDim outputArrayTranspose(LBound(arr, 2) To UBound(arr, 2), _ LBound(arr) To UBound(arr)) As Double Case "Integer()" ReDim outputArrayTranspose(LBound(arr, 2) To UBound(arr, 2), _ LBound(arr) To UBound(arr)) As Integer Case "Long()" ReDim outputArrayTranspose(LBound(arr, 2) To UBound(arr, 2), _ LBound(arr) To UBound(arr)) As Long Case "Single()" ReDim outputArrayTranspose(LBound(arr, 2) To UBound(arr, 2), _ LBound(arr) To UBound(arr)) As Single Case "String()" ReDim outputArrayTranspose(LBound(arr, 2) To UBound(arr, 2), _ LBound(arr) To UBound(arr)) As String Case "Variant()" ReDim outputArrayTranspose(LBound(arr, 2) To UBound(arr, 2), _ LBound(arr) To UBound(arr)) As Variant Case Else Msg = "#ERROR! Only built-in types of arrays are supported." If TypeOf Application.Caller Is Range Then ArrayTranspose = Msg Else MsgBox Msg, 16 End If Exit Function End Select If TypeName(arr) < "Object()" Then For i = LBound(outputArrayTranspose) To _ UBound(outputArrayTranspose) For j = LBound(outputArrayTranspose, 2) To _ UBound(outputArrayTranspose, 2) outputArrayTranspose(i, j) = arr(j, i) Next Next End If End If 'Return the transposed array ArrayTranspose = outputArrayTranspose End Function Alan Beban Ulrik Petersen wrote: Hi. Does anyone know how to transpose for instance a 2x2 matrix in VBA, Excel 2000? |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Sumproduct with Matrices | Excel Discussion (Misc queries) | |||
matrices | Excel Discussion (Misc queries) | |||
How to solve y =f(x,y) using matrices? | Excel Worksheet Functions | |||
Combining certain matrices | Excel Discussion (Misc queries) | |||
transpose matrices | Excel Programming |