Excel:将simgle列的数据拆分为多列列式VBA

时间:2017-05-31 09:00:49

标签: excel vba excel-vba

我在excel中有一些数据,如下所示:

david@david-VirtualBox:~$ mysql -u root -p test_project < db.sql
Enter password: 
ERROR 1030 (HY000) at line 25: Got error 168 from storage engine`

mysql> show databases;
+--------------------+
| Database           |
+--------------------+
| information_schema |
| mysql              |
| performance_schema |
| sys                |
| testBase           |
| test_project       |
+--------------------+
6 rows in set (0,05 sec)

mysql> use test_project;
Database changed

mysql> show tables;
Empty set (0,00 sec)

当我使用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   2   3   4   5
6   7   8   9   10
11  12  13  14  15
16  17  18  19  20
21  22  23

我使用了here给出的代码,但它要求行数。我想让它询问列数,然后像ASAP Utilities那样拆分数据。

欢迎所有积极的建议......

4 个答案:

答案 0 :(得分:1)

尝试使用此代码,用户友好,

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

enter image description here

输入5后,点击Ok

enter image description here

,您的代码就在这里,

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

此代码根据您的输入动态拆分列。希望这会有所帮助。

答案 1 :(得分:0)

像这样的东西,还没有完全测试,但是一个开始。

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

答案 2 :(得分:0)

请尝试这段代码,

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




它提供了类似

的输出

called 1

called 2

答案 3 :(得分:0)

这将按您想要的顺序将您的范围分成5列。它需要您将With语句更新为您正在查看的相关工作表,并且可以通过将NoCols变量更改为您在输出中所需的多列来更改拆分。 / p>

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