|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
两种方法:
1.工作表方法复制、转置粘贴
- Sub test1()
- m = Range("G2") '指定转置行数m
-
- With Range("B5")
- n = .CurrentRegion.Columns.Count '原始区域列数
- .Offset(, n + 2).CurrentRegion.Clear
- Do
- ' tr = .Offset(i * m).Resize(m, n) '按指定转置行数m间隔读取数据到数组tr
- ' .Offset(i * n, n + 2).Resize(n, m) = WorksheetFunction.Transpose(tr) '转置输出
- .Offset(i * m).Resize(m, n).Copy '复制
- .Offset(i * n, n + 2).PasteSpecial Paste:=xlPasteAll, Transpose:=True '转置粘贴
- i = i + 1
- Loop Until .Offset(i * m) = ""
- End With
- MsgBox "OK"
- End Sub
复制代码
第2种方法,数组循环赋值后输出
- Sub test2()
- n2 = Range("G2") '指定转置行数n2
- ar = Range("B5").CurrentRegion '原始数据读入数组ar
- m = UBound(ar): n = UBound(ar, 2)
- Range("B5").Offset(, n + n2 + 4).CurrentRegion = ""
- ReDim br(1 To m / n2 * n, 1 To n2)
- For i = 0 To m - 1 Step n2
- For j = 1 To n2
- For i2 = 1 To n
- br(i / n2 * n + i2, j) = ar(i + j, i2)
- Next
- Next
- Next
- Range("B5").Offset(, n + n2 + 4).Resize(UBound(br), n2) = br
- MsgBox "OK"
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|