将列转换为行

Question

我正在尝试将列中的数据转换为行，但是通过垂直列。

数据示例：

A B C 
1 2 3 
D E F

我希望它能像这样转换成一行：

A
1
D
B
2
E
C
3
F

我正在使用我在网上找到的代码

    Sub ConvertRangeToColumn()

Dim Range1 As Range, Range2 As Range, Rng As Range
Dim rowIndex As Integer
xTitleId = "KutoolsforExcel"
Set Range1 = Application.Selection
Set Range1 = Application.InputBox("Source Ranges:", xTitleId, Range1.Address, Type:=8)
Set Range2 = Application.InputBox("Convert to (single cell):", xTitleId, Type:=8)
rowIndex = 0
Application.ScreenUpdating = False
For Each Rng In Range1.Rows
    Rng.Copy
    Range2.Offset(rowIndex, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
    rowIndex = rowIndex + Rng.Columns.Count
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

但是，这只能将我的数据转换为：

A 
B
C 
1 
2
3 
D 
E 
F

因为它横向搜索数据。

我可以做些什么调整来改变它？感谢

Answer 1

尝试，

dim c as long, r as long

for c=  2 to cells(1, columns.count).end(xltoleft).column
    for r=1 to cells(rows.count, c).end(xlup).row
        cells(rows.count, "A").end(xlup).offset(1, 0) = cells(r,c)
    next r
    columns(c).clear
next c

Answer 2

我这里只做了3次调整，以适合您找到适合您情况的代码。

Sub ConvertRangeToColumn()

Dim Range1 As Range, Range2 As Range, Rng As Range
Dim rowIndex As Integer

Set Range1 = Application.Selection
Set Range1 = Application.InputBox("Source Ranges:", xTitleId, Range1.Address, Type:=8)
Set Range2 = Application.InputBox("Convert to (single cell):", xTitleId, Type:=8)

rowIndex = 0
Application.ScreenUpdating = False

For Each Rng In Range1.Columns
    Rng.Copy
    Range2.Offset(rowIndex, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=False
    rowIndex = rowIndex + Rng.Rows.Count
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Answer 3

主要使用您的代码：

Sub ConvertRangeToColumn()
  Dim xTitleId$
  Dim Range1 As Range, Range2 As Range, Rng As Range
  Dim rowIndex As Integer
  xTitleId = "KutoolsforExcel"
  Set Range1 = Application.Selection
  Set Range1 = Application.InputBox("Source Ranges:", xTitleId, Range1.Address, Type:=8)
  Set Range2 = Application.InputBox("Convert to (single cell):", xTitleId, Type:=8)
  rowIndex = 0
  Application.ScreenUpdating = False
  For Each Rng In Range1.Columns
      Rng.Copy
      Range2.Offset(rowIndex, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=False
      rowIndex = rowIndex + Rng.Rows.Count
  Next
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

Answer 4

您可以通过仅处理范围值来避免粘贴特殊和随后的剪贴板清除：

Sub ConvertRangeToColumn()
    Dim Range2 As Range
    Dim xTitleId As String
    Dim iCol As Long

    xTitleId = "KutoolsforExcel"
    Set Range2 = Application.InputBox("Convert to (single cell):", xTitleId, Type:=8) 'get cell where to start writing down

    With Application.InputBox("Source Ranges:", xTitleId, Selection.Address, Type:=8) ' get and reference the 2D range to be "transformed" into 1 column
        For iCol = 1 To .Columns.Count ' loop through referenced range columns
            Range2.Offset((iCol - 1) * .Rows.Count, 0).Resize(.Rows.Count).Value = .Columns(iCol).Value ' write referenced range current column values into 'Range2 proper row offset'
        Next
    End With
End Sub

Answer 5

您可以使用 Power Query，可在 Windows Excel 2010+ 和 Office 365 中使用

根据您希望的订购方式

• 转置
• 选择所有列后取消透视
• 删除 Attribute 列

注意：创建表格时，由于没有标题，请务必取消选择“我的表格有标题”框

M 代码

let
    Source = Excel.CurrentWorkbook(){[Name="Table7"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type any}, {"Column2", type any}, {"Column3", type any}}),
    #"Transposed Table" = Table.Transpose(#"Changed Type"),
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(#"Transposed Table", {}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Columns",{"Attribute"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Removed Columns",{{"Value", type text}})
in
    #"Changed Type1"

Answer 6

如果您处理新的动态 Excel 函数 ArrayToText 和 Transpose (Excel/MS365)，您可以使用简单的 udf：

Public Function Split2Col(rng As Range)
    Dim tmp: tmp = Evaluate("ArrayToText(Transpose(" & rng.Address(False, False, External:=True) & "))")
    Split2Col = Application.Transpose(Split(tmp, ", "))   
End Function