vba - 将某行数据移入列

Question

如果我将所有数据放在一个非常长的列中，如下所示:

 A
 B
 C
 1
 2
 3

 D
 E
 F
 4
 5
 6

 G
 H
 I
 7
 8
 9

可以像这样移动数据吗？

Column1  Column2  Column3  Column4  Column5  Column6
A        B        C        1        2        3
D        E        F        4        5        6
G        H        I        7        8        9

我试过 paste special+transpose ，但我有超过一万条记录，所以使用这种方法会花费我太多时间。

我是excel和macro的新手，非常感谢。

编辑:

我什至尝试将所有数据转换为多列，然后使用此宏选择我想要将它们全部转换为一列的列:

Sub OneColumn()
 ' Jason Morin as amended by Doug Glancy
 ' http://makeashorterlink.com/?M19F26516
 ''''''''''''''''''''''''''''''''''''''''''
 'Macro to copy columns of variable length
 'into 1 continuous column in a new sheet 
 ''''''''''''''''''''''''''''''''''''''''''

 Dim from_lastcol As Long
 Dim from_lastrow As Long
 Dim to_lastrow As Long
 Dim from_colndx As Long
 Dim ws_from As Worksheet, ws_to As Worksheet

 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

 Set ws_from = ActiveWorkbook.ActiveSheet
 from_lastcol = ws_from.Cells(1, Columns.Count).End(xlToLeft).Column

 'Turn error checking off so if no "AllData" trying to delete doesn't generate Error
 On Error Resume Next
 'so not prompted to confirm delete
 Application.DisplayAlerts = False
 'Delete if already exists so don't get error
 ActiveWorkbook.Worksheets("AllData").Delete
 Application.DisplayAlerts = True
 'turn error checking back on
 On Error GoTo 0

 'since you refer to "AllData" throughout
 Set ws_to = Worksheets.Add
 ws_to.Name = "AllData"

 For from_colndx = 1 To from_lastcol
     from_lastrow = ws_from.Cells(Rows.Count, from_colndx).End(xlUp).Row
 'If you're going to exceed 65536 rows
 If from_lastrow + ws_to.Cells(Rows.Count, 1).End(xlUp).Row <= 65536 Then
    to_lastrow = ws_to.Cells(Rows.Count, 1).End(xlUp).Row
Else
    MsgBox "This time you've gone to far"
    Exit Sub
End If
ws_from.Range(ws_from.Cells(1, from_colndx), ws_from.Cells(from_lastrow, _
  from_colndx)).Copy ws_to.Cells(to_lastrow + 1, 1)
Next

' this deletes any blank rows
 ws_to.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic 

 End Sub

但它只会将所有列合并为一个，而不是选定的列。

Remou 引用:

这是输出:

 A   D   G

 B   E   H

 C   F   I

 1   4   7

 2   5   8

 3   6   9  

Answer 1

您可以在以下几行中查看某些内容:

Sub TransposeColumn()
Dim rng As Range
Dim ws As Worksheet
Set rng = Worksheets("Input").UsedRange
Set ws = Worksheets("Output")
j = 1
k = 1
For i = 1 To rng.Rows.Count
    If rng.Cells(i, 1) = vbNullString Then
        j = j + 1
        k = 1
    Else
        ''ws.Cells(k, j) = rng.Cells(i, 1)
        ''EDIT
        ws.Cells(j, k) = rng.Cells(i, 1)
        k = k + 1
    End If
Next

End Sub