将一列数据一条龙排列为多行多列？谢谢！

wangweihebtu

将一列数据一条龙排列为多行多列？谢谢！

⊙⊙小噤○

1.     Sub 分列()
   
2.         Dim 列数 As Long
   
3.         列数 = InputBox("输入列数")
   
4.         Dim 待分个数 As Long
   
5.         待分个数 = Cells(Rows.Count, 1).End(xlUp).Row
   
6.         Dim 行 As Long
   
7.         Dim 列 As Long
   
8. 
   
9.         For 行 = 1 To 待分个数 Step 列数
   
10.             For 列 = 3 To (列数 + 2)
    
11. 
    
12.                 Cells(-Int(-(行 / 列数)), 列) = Cells(行 + 列 - 3, 1)
    
13.             Next
    
14.         Next
    
15. 
    
16.     End Sub

复制代码

chaohuahch

你说列会变，但是看不知道你变的依据，所以就按照目前的列数写了一个代码。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   ls = Application.InputBox(prompt:="请输入要排列的列数：", Title:="操作提示", Default:=5, Type:=1)
   
5.   With Worksheets("sheet1")
   
6.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
7.     arr = .Range("a1:a" & r)
   
8.     hs = Application.Ceiling(UBound(arr) / ls, 1)
   
9.     ReDim brr(1 To hs, 1 To ls)
   
10.     m = 1
    
11.     n = 1
    
12.     For i = 1 To UBound(arr)
    
13.       brr(m, n) = arr(i, 1)
    
14.       If m Mod 2 = 1 Then
    
15.         n = n + 1
    
16.         If n > ls Then
    
17.           n = ls
    
18.           m = m + 1
    
19.         End If
    
20.       Else
    
21.         n = n - 1
    
22.         If n < 1 Then
    
23.           n = 1
    
24.           m = m + 1
    
25.         End If
    
26.       End If
    
27.     Next
    
28.     .Range("c1").Resize(UBound(brr), UBound(brr, 2)) = brr
    
29.   End With
    
30.         
    
31. End Sub
    

复制代码

chxw68

这个一般叫蛇形排列或“N”形排列。

wangweihebtu

chxw68 发表于 2018-7-14 20:08
这个一般叫蛇形排列或“N”形排列。

十分感谢，要的就是这个效果！！！