Excel行变列的问题（在线等待）

[wp315]

我又一个excel表 现在有3411行，1列，将来会更长。
我需要每隔106行的内容变成1行，106列，以此类推。
我录的个宏，内容如下：
Sub book1()
'
' book1 Macro
' 宏由 www 录制，时间: 2008-9-17
'

'

Rows("1:106").Select
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

Range("A2").Select

Sheets("Sheet1").Select
Rows("107:212").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("A3").Select
Sheets("Sheet1").Select
Rows("213:318").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

End Sub


这样是可以成功的排列前三行，我想请问怎么些可以一直这样排列下去，一直到表末呢？我vb不是很懂，希望能提供详细代码，谢谢了！

[wp315]

我就是想要循环控制呀，不然n长的表，我这么copy要到什么时候呀！

[gzlwch]

试下：
中间部分改为：

for i=1 to 40
Range("A"&i").Select
Sheets("Sheet1").Select
Rows("(i-1)*106+1:i*106").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next

[wp315]

For i = 1 To 40
Range("A"&i").Select
Sheets("Sheet1").Select
Rows("(i-1)*106+1:i*106").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next

End Sub

这句话报错 好像不行呀！

[wp315]

改成 Range("A"&“i").Select 这个后
说 方法“range”作用于对象'_Global' 时失败

[wp315]

自己顶一下

[lelige]

写了一个，试试看。
原始表是Sheet1，粘贴至Sheet2，106可以自行修改成其它值。

Sub Test1()
    Sheets("Sheet1").Select
    ActiveSheet.Cells(1, 1).CurrentRegion.Select
    intLastRow = Selection.Row + Selection.Rows.Count - 1
    intRowHeight = 106
    Do While True
        i = i + 1
        If (i - 1) * intRowHeight + 1 > intLastRow Then
            Exit Do
        End If
        Range(Cells((i - 1) * intRowHeight + 1, 1), Cells(i * intRowHeight, 1)).Select
        Selection.Copy
        Sheets("Sheet2").Select
        Range("A" & i).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Sheets("Sheet1").Select
    Loop
End Sub

[gracexu]

 
Sub book1()
Dim rNum As Long
Dim i As Long
Dim workRg As String
Sheets("Sheet3").Select
rNum = Rows(1).CurrentRegion.Count
   
For i = 1 To Int(rNum / 106) + 1
    workRg = (i - 1) * 106 + 1 & ":" & i * 106
    Rows(workRg).Select
    Selection.Copy
    Sheets("Sheet4").Select
    Range("A" & i).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("Sheet3").Select
Next i
End Sub

[wp315]

谢谢lelige 这个是可以 可问题是怎么循环下去呢 我是没106行要变成一行106列，如此循环。

[gracexu]

[Quote=引用 6 楼 wp315 的回复:]

For i = 1 To 40
Range("A"&i").Select
Sheets("Sheet1").Select
Rows("(i-1)*106+1:i*106").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next

End Sub

这句话报错 好像不行呀！
[/Quote]

这是因为"A" 和 & 之间需要一个空格，& 和 i 之间也需要。
我是用表3 表4 做测试的，楼主相应改成 sheet1 和 sheet2.

[gracexu]

i 后面不需要那个引号。

[lelige]

[Quote=引用 11 楼 wp315 的回复:]
谢谢lelige 这个是可以 可问题是怎么循环下去呢 我是没106行要变成一行106列，如此循环。
[/Quote]

上面的代码已经包含循环了，前提是你的3411行是连续的，中间没有空行。

[gracexu]

[Quote=引用 11 楼 wp315 的回复:]
谢谢lelige 这个是可以 可问题是怎么循环下去呢 我是没106行要变成一行106列，如此循环。
[/Quote]
这句话什么意思，楼主不是数据结束就复制完吗？

[wp315]

谢谢gracexu ，我试了你的代码，可以运行，但是只排列了第一个106行，后面的还是没反应呀！请问后面的应该怎么办呢，因为我是要每106行变一下。

[wp315]

不是的 我是106行一个循环，一直到数据结束，现在这个表就有3千多行了，估计以后会有10万行，我一直需要按这个格式排列。

[gracexu]

我在你代码基础上改的，测试通过的啊。

 Sub book1()
Dim rNum As Long
Dim i As Long
Dim workRg As String
Sheets("Sheet1").Select
rNum = Rows(1).CurrentRegion.Count
   
For i = 1 To Int(rNum / 106) + 1
    workRg = (i - 1) * 106 + 1 & ":" & i * 106
    Rows(workRg).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A" & i).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("Sheet1").Select
Next i
End Sub

[lelige]

这样吧，你把上面的代码中

ActiveSheet.Cells(1, 1).CurrentRegion.Select

改成

ActiveSheet.Range("A1:A3411").Select

试试。

[gracexu]

[Quote=引用 17 楼 wp315 的回复:]
不是的 我是106行一个循环，一直到数据结束，现在这个表就有3千多行了，估计以后会有10万行，我一直需要按这个格式排列。
[/Quote]

我看你原始的代码是从第一行开始复制，你这3千多行是连续，中间没空格的吗？
我们代码里用的 CurrentRegion 这个属性就是想获得你连续数据的行数，但是中间有空行的话，后面的就不算了。

如果你知道行数的话，你可以直接把行数写在代码里
For i = 1 To Int(你需要的行数 / 106) + 1

[lelige]

果然是有空行，用这个吧。

Sub Test1()
    Sheets("Sheet1").Select
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    intLastRow = Selection.Row + Selection.Rows.Count - 1
    intRowHeight = 106
    Do While True
        i = i + 1
        If (i - 1) * intRowHeight + 1 > intLastRow Then
            Exit Do
        End If
        Range(Cells((i - 1) * intRowHeight + 1, 1), Cells(i * intRowHeight, 1)).Select
        Selection.Copy
        Sheets("Sheet2").Select
        Range("A" & i).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Sheets("Sheet1").Select
    Loop
End Sub

[gzlwch]

dim i, j, k
For i = 1 To 40
Range("A"&i").Select
Sheets("Sheet1").Select
set k=(i-1)*106+1
for j=1 to 106
Rows(k).Select
set k=k+1
next
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next

加了个循环控制，不知道是否可行。呵呵。学习了。

[gracexu]

晕，楼上的字符串连接还是不过关。