EXCEL如何用VBA实现一列数据平均分成7列数据？

Question

已知EXCEL表的表1里A列有7000多行数据，我想把它们在表2里（不想影响原始数据），分成7列1000多行的数据，如何用VBA实现？求高手解答。
请用VBA实现，谢谢大家！

Answer 1

给你代码吧。

Sub bb()
    Dim iEndRow, iAve, j, i
    iEndRow = Sheet1.[a65536].End(xlUp).Row
    iAve = Fix(iEndRow / 7)
    
    j = 1
    For i = 1 To Sheet1.[a65536].End(xlUp).Row
        If i Mod iAve = 0 Then
            Sheet2.Cells(iAve, j).Value = Sheet1.Cells(i, 1).Value
            j = j + 1
        Else
             Sheet2.Cells(i Mod iAve, j).Value = Sheet1.Cells(i, 1).Value
        End If
       
    Next
End Sub追问

谢谢！！非常接近我想要的效果，能不能让数据从行开始，我现在得到的数据是，前6列全部正常，最后一列只有几行数据，我想得到的效果是，每列数据都很饱满，最后一行数据很少，(⊙o⊙)…，不知道我有没有说清楚意思，能帮我再改改吗？

追答Sub bbb()
    Dim iEndRow, iAve, j, i
    iEndRow = Sheet1.[a65536].End(xlUp).Row
    iAve = Fix(iEndRow / 7)
    For i = 1 To Sheet1.[a65536].End(xlUp).Row
        j = IIf(i Mod 7 = 0, 7, i Mod 7)
        Sheet2.Cells(Application.WorksheetFunction.RoundUp(i / 7, 0), j).Value = Sheet1.Cells(i, 1).Value
    Next
End Sub追问

完美，是我想要的效果，谢谢“王延春”大侠！

Answer 2

这样子试试吧，呵呵……
Sub 分列()
For i = 1 To 7000 Step 1000
Sheet1.Activate
Sheet1.Range(Cells(i, 1), Cells(i + 1000 - 1, 1)).Select
Selection.Copy
Sheets(2).Activate
Cells(1, (i + 1000) / 1000).Select
ActiveSheet.Paste
Next i
End Sub追问

谢谢回复，不过，这提示缺少对象啊

Answer 3

Sub cs()
arr = Sheet1.Range("A1").CurrentRegion.Resize(, 1)
r = UBound(arr)
ReDim brr(Int(r / 7), 6)
For i = 1 To r
brr(h, l) = arr(i, 1)
l = l + 1
If l = 7 Then h = h + 1: l = 0
Next
Sheet2.Range("A1").Resize(h + 1, 7) = brr
End Sub追问

谢谢回复，不知道什么原因，我这里显示下标越界

追答

上面的已经重新修改过了，现在不会再下标越界，你再复制测试下。

追问

非常感谢您的回复，我就是想要这种效果，不过这些代码，够我消化一阵子了，初学VBA，无从下手的感觉，前面那位“王延春”大侠的代码也很简洁，这个确实是我要的效果！

本回答被提问者采纳