[已解决]行分组转列求助

鄱湖人2013121 · 发表于 2014-4-3 20:49

将表1用VBA转换成表2,请高手帮忙

最佳答案

月排行榜 / 总排行榜

dsmch

2014-4-3 21:23

………………

跳转到最佳答案楼层

鄱湖人2013121 · 发表于 2014-4-3 20:51

附件如下

dsmch · 发表于 2014-4-3 21:04

本帖最后由 dsmch 于 2014-4-3 21:21 编辑

Sub Macro1()
Dim arr, i&, j%, s&
Sheet1.Activate
arr = Range("a1").CurrentRegion
s = 1
For i = 3 To UBound(arr)
For j = 1 To UBound(arr, 2) Step 4
s = s + 1
Cells(i, j).Resize(1, 4).Copy Sheet2.Cells(s, 1)
Next
Next
[e2:h2].Copy Sheet2.[a1]
Sheet2.Activate
End Sub

复制代码

tgydslr · 发表于 2014-4-3 21:06

坐板凳上期待解答

鄱湖人2013121 · 发表于 2014-4-3 21:14

01.Sub Macro1()

02.Dim arr, brr(1 To 20000, 1 To 5), i&, j%, k%, s&

03.arr = Sheet2.Range("b2").CurrentRegion

04.For i = 1 To UBound(arr)

05. For j = 1 To UBound(arr, 2) Step 4

06.       If arr(i, j) <> "" Then

07.          s = s + 1

08.          For k = 0 To 3

09.             brr(s, k + 1) = arr(i, j + k)

10.          Next

11.          brr(s, 5) = s + 110

12.       End If

13. Next

14.Next

15.Range("l2").Resize(s, 5) = brr

16.End Sub

17.

鄱湖人2013121 · 发表于 2014-4-3 21:17

此过程列数一多(4列一组的提取,但组一多)就会出现运行错误9,下标超界

dsmch · 发表于 2014-4-3 21:23

………………

鄱湖人2013121 · 发表于 2014-4-3 21:38

感谢dsmch,非常好,就是有空行,后续行的数据就没有了,其余效果非常好,

dsmch · 发表于 2014-4-3 21:46

鄱湖人2013121 发表于 2014-4-3 21:38
感谢dsmch,非常好,就是有空行,后续行的数据就没有了,其余效果非常好,

不清楚你实际数据的结构，这样试试
arr = ActiveSheet.UsedRange

鄱湖人2013121 · 发表于 2014-4-3 22:03

		自动登录	找回密码
密码			注册