Excel VBA 求大佬看看修改

250334385

1. Sub hx()
   
2. Dim rg As Range
   
3. For Each rg In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
   
4.     Cells(Int((rg.Row - 1) / 4) + 1, ((rg.Row - 1) Mod 4) + 2) = rg
   
5. Next
   
6. End Sub

复制代码

得到的结果是 将A列平均分4列如果

但是我想要的是 分4列 每列之间空一列如图

求大佬 怎么修改 本人不懂VBA  上面代码也是百度来的
2015年的 联系不上原来的发布者

不知道为什么

Sub hx()
Dim rg As Range
For Each rg In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)

    Cells(Int((rg.Row - 1) / 4) + 1, ((rg.Row - 1) Mod 4) * 2 + 3) = rg
Next
End Sub

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   With Worksheets("sheet1")
   
4.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
5.     sl = Application.Ceiling(r / 4, 1)
   
6.     n = 2
   
7.     For i = 1 To r Step sl
   
8.       .Cells(i, 1).Resize(sl, 1).Copy .Cells(1, n)
   
9.       n = n + 2
   
10.     Next
    
11.   End With
    
12. End Sub
    

复制代码

不知道为什么

稍微修改就可以    * 2

1. <blockquote>Sub hx()

复制代码

chxw68

详见附件。

250334385

chxw68 发表于 2018-6-15 19:22
详见附件。

感谢 你这个是竖下来分布的 但是我在第一列 再添加新数据 重新分类  原来已经分列的就会变动
已经有其它大神解救我的问题  感谢您的回答

hopeson2010

1. Sub ek_sky()
   
2.    Dim arr As Variant, brr As Variant
   
3.        arr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
   
4.        ReDim brr(1 To UBound(arr), 1 To 8)
   
5.            For i = 1 To UBound(arr)
   
6.            brr(Int((arr(i, 1) - 1) / 4) + 1, ((i - 1) Mod 4) * 2 + 1) = arr(i, 1)
   
7.            Next i
   
8. Range("G1").Resize(UBound(arr), 8) = brr
   
9. End Sub

复制代码