EXCEL如何用VBA实现一列数据平均分成7列数据?
答案:3 悬赏:20 手机版
解决时间 2021-02-05 12:18
- 提问者网友:战魂
- 2021-02-04 19:10
EXCEL如何用VBA实现一列数据平均分成7列数据?
最佳答案
- 五星知识达人网友:逃夭
- 2021-02-04 20:19
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,无从下手的感觉,前面那位“王延春”大侠的代码也很简洁,这个确实是我要的效果!
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,无从下手的感觉,前面那位“王延春”大侠的代码也很简洁,这个确实是我要的效果!
全部回答
- 1楼网友:鸠书
- 2021-02-04 22:53
这样子试试吧,呵呵……
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追问谢谢回复,不过,这提示缺少对象啊
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追问谢谢回复,不过,这提示缺少对象啊
- 2楼网友:孤独的牧羊人
- 2021-02-04 21:36
给你代码吧。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追问完美,是我想要的效果,谢谢“王延春”大侠!
我要举报
如以上问答信息为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
大家都在看
推荐资讯