sbReShape
If you like to reshape a one- or two-dimensional array you can use the UDF sbReShape shown below:
[Please notice that you need to enter this function as an array-function!]
Function sbReShape(v As Variant, _
Optional bByRow As Boolean = True, _
Optional lColumns As Long = 1) As Variant
'Reverse("moc.LiborPlus.www") PB 09-Oct-2012 V0.6
Dim vP As Variant, vI As Variant, vR As Variant
Dim i(1 To 2) As Long, j As Long
Dim k(1 To 2) As Long, rc(1 To 2) As Long
With Application.WorksheetFunction
vP = .Transpose(.Transpose(v))
End With
With Application.Caller
j = 2 + bByRow
If TypeName(Application.Caller) = "Range" Then
rc(1) = .Columns.Count
rc(2) = .Rows.Count
Else
rc(1) = lColumns
rc(2) = 1
End If
ReDim vR(1 To rc(1), 1 To rc(2))
i(1) = 1
i(2) = 1
For Each vI In v
vR(i(3 - j), i(j)) = vI
i(2) = i(2) + 1
If i(2) > rc(j) Then
i(2) = 1
i(1) = i(1) + 1
If i(1) > rc(3 - j) Then
sbReShape = Application.WorksheetFunction.Transpose(vR)
Exit Function
End If
End If
Next vI
fillcverrval:
vR(i(3 - j), i(j)) = CVErr(xlErrValue)
i(2) = i(2) + 1
If i(2) > rc(j) Then
i(2) = 1
i(1) = i(1) + 1
If i(1) > rc(3 - j) Then
sbReShape = Application.WorksheetFunction.Transpose(vR)
Exit Function
End If
End If
GoTo fillcverrval
End With
End Function
sbReShape.xlsm
15KB
Binary
sbReShape.xlsm
Last modified 2yr ago