Excel：将simgle列的数据拆分为多列按列VBA

我在excel中有一些数据，如下所示：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

当我使用ASAP实用程序将其拆分为多个列时。它按列拆分数据。假设我要将其拆分为5列，它将以行方式进行，如下所示：

1   2   3   4   5
6   7   8   9   10
11  12  13  14  15
16  17  18  19  20
21  22  23

1   6   11  16  20
2   7   12  17  21
3   8   13  18  22
4   9   14  19  23
5   10  15      

但是，我想按如下方式将其按列拆分：

1   2   3   4   5
6   7   8   9   10
11  12  13  14  15
16  17  18  19  20
21  22  23

1   6   11  16  20
2   7   12  17  21
3   8   13  18  22
4   9   14  19  23
5   10  15      

我使用了给定的代码，但它要求行数。我希望它询问列数，然后像ASAP实用程序那样分割数据

---

欢迎所有积极的建议…

类似这样的建议，尚未完全测试，但只是一个开始

Sub t()

Dim xDimension As Integer
Dim lngLoopCount As Long
Dim lngLastRow As Long
Dim lngPresentation As Long

xDimension = 5
lngPresentation = 1

lngLastRow = Range("a1").End(xlDown).Row

For lngLoopCount = 1 To lngLastRow Step xDimension
    Range("c1").Offset(lngPresentation, 0).Resize(1, xDimension).Value = _
                Application.Transpose(Range("a1").Offset(lngLoopCount - 1, 0).Resize(xDimension, 1).Value)
    lngPresentation = lngPresentation + 1
Next

End Sub

---

请试试这段代码

Function SPLITARR(ByRef v() As Variant, MaxRow As Integer) As Variant
  Dim ArraySize As Integer
  Dim MaxCols As Integer
  Dim NewArray() As Variant
  Dim x As Integer, y As Integer, z As Integer

  ArraySize = (UBound(v(), 1) - LBound(v(), 1)) + 1
  MaxCols = ArraySize \ MaxRow

  If ArraySize Mod MaxRow > 0 Then MaxCols = MaxCols + 1
  ReDim NewArray(LBound(v(), 1) To MaxRow, 1 To MaxCols)
  For x = LBound(v(), 1) To UBound(v(), 1)
    y = x Mod MaxRow
    If y = 0 Then y = MaxRow
    z = x \ MaxRow
    If x Mod MaxRow = 0 Then z = z - 1
    NewArray(y, z + 1) = v(x, 1)
  Next
  SPLITARR = NewArray()
End Function

应该叫做

Sub caller()
Dim a() As Variant
a() = Range("A1",Range("A" & Rows.Count).End(xlUp))
a() = SPLITARR(a(), 5) '<~ change this to your needs
ActiveCell.Resize(UBound(a(), 1), UBound(a(), 2)).Value = a()
End Sub

Sub调用者（）
Dim a（）作为变量
a（）=范围（“A1”，范围（“a”和Rows.Count）.End（xlUp））
a（）=SPLITARR（a（），5）这将按照您想要的顺序将您的范围拆分为5列。您需要将
With
语句更新到您正在查看的相关工作表中，并且可以通过将
NoCols
变量更改为您希望在输出中显示的列数来更改拆分

Public Sub SplitRange()
    Dim arr As Variant, tmp As Variant
    Dim i As Long, j As Long
    Dim NoCols As Long
    Dim rng As Range
    Dim c

    ' Change this to how many columns you want
    NoCols = 5

    ' Change to your sheet
    With Sheet6
        .Range(.Columns(4), .Columns(20)).Clear
        Set rng = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
        tmp = rng.Value2

        ReDim arr(1 To WorksheetFunction.RoundUp(UBound(tmp) / NoCols, 0), 1 To NoCols)

        i = 1: j = 1
        For Each c In tmp
            If i > WorksheetFunction.RoundUp(UBound(tmp) / NoCols, 0) Then j = j + 1: i = 1
                arr(i, j) = c
            i = i + 1
        Next c

        With .Cells(1, 4)
            Range(.Offset(0, 0), .Offset(UBound(arr, 1) - 1, UBound(arr, 2) - 1)) = arr
        End With
    End With
End Sub

试试这段代码，有点用户友好

运行此宏时，
vba
显示一个文本框，您可以在其中输入要将数据拆分成的列数


当您输入
5
，然后单击
Ok


你的代码在这里

Sub transpose()
Dim col As Variant, i As Long, j As Long, k As Long
col = InputBox("Enter number of columns")
col = Cells(Rows.Count, 1).End(xlUp).Row / col
col = WorksheetFunction.RoundUp(col, 0)
j = 1
k = 3
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    Cells(j, k) = Cells(i, 1)
    j = j + 1
    If j > col Then
        j = 1
        k = k + 1
    End If
Next i
End Sub

此代码根据您的输入动态拆分列。希望这有帮助。
它是按行排列的。我希望它按列排列。正如你在第二次拆分中看到的，我给了你一些几何图形，看看
offset
和
resize
来看看如何切换。我没有让你等一下，这里有错别字吗？我想直接调用它而不使用event直接调用它作为
按钮1\u Click（）
你的意思是说不，当我点击RunI时，该程序应该直接执行。我将编辑这个答案，并假设您在A列中列出了这些数字。当然，那太好了