エラー処理とか、2次元配列以外の処理とかは特に考慮していません。
Function CreateTranspose(ByVal v As Variant) Dim w As Variant Dim maxR As Long, maxC As Long Dim minR As Long, minC As Long maxR = UBound(v) minR = LBound(v) maxC = UBound(v, 2) minC = LBound(v, 2) ReDim w(minC To maxC, minR To maxR) Dim i As Long, j As Long For i = minR To maxR For j = minC To maxC w(j, i) = v(i, j) Next j Next i CreateTranspose = w End Function