矩阵转换VBA代码，喜欢的小伙伴拿去用

实际请根据需求适当修改代码，这里源数据按列从到右存放。如果源数据是按行从上往下存放，请先转置。
VBA代码如下：
Sub New_Trans()
Call MyTrans(0) '0按列匹配数据，1按行匹配数据
End Sub
Sub MyTrans(ByVal MatchOrder As Integer)
Dim rng As Range, arr, temp, myarr
Dim i&, j&, m&, n&, r&, c&
Sheet1.Activate '默认原始数据在shee1工作表
Set rng = Application.InputBox(prompt:="请选择源数据区域", _
Title:="数据转换", Type:=8)
r = rng.Rows.Count
c = rng.Columns.Count
arr = rng
ReDim temp(1 To r * c)
For j = 1 To c
For i = 1 To r
temp((j - 1) * r + i) = arr(i, j)
Next
Next
m = Application.InputBox(prompt:="请输入转换后的行数", _
Title:="数据转换", Type:=1)
n = Application.InputBox(prompt:="请输入转换后的列数", _
Title:="数据转换", Type:=1)
If UBound(temp) <= m * n Then
ReDim myarr(1 To m, 1 To n)
If MatchOrder = 0 Then
For j = 1 To n
For i = 1 To m
If UBound(temp) >= (j - 1) * m + i Then
myarr(i, j) = temp((j - 1) * m + i)
End If
Next
Next
ElseIf MatchOrder = 1 Then
For i = 1 To m
For j = 1 To n
If UBound(temp) >= (i - 1) * n + j Then
myarr(i, j) = temp((i - 1) * n + j)
End If
Next
Next
End If
Sheet2.Activate '默认转换后的数据放入sheet2工作表，如果转换后的数据还在sheet1, 请删掉这句
[a1].CurrentRegion.ClearContents '默认清空A1单元格周围所有数据
[a1].Resize(m, n) = myarr '默认从A1开始放数据
Else
MsgBox prompt:="数据输入错误", Title:="数据转换"
Exit Sub
End If
End Sub