将多行数据列转置为一列

Question

我正在尝试将多列行转换为一列

我知道有人问过这个问题，我已经尝试过一段时间，但无法根据需要让它工作。我在前面的例子中遇到的问题是输出不是我需要的格式，它对数字进行分组而不是按顺序排列。

示例数组是：

1 1 1 
2 2 2
3 3 3
4 4 4

输出：

1
2
3
4
1
2
3
4
1
2
3
4

我知道这种大小的数据可以在 excel 的查询编辑器中完成。但我需要将数据序列复制到 2300 行。因此，我的示例数组数据将包含 2300 行，这需要很长时间才能取消透视。此外，unpivot 函数不会将数据合并到订单中。

我已经从post 尝试了这个示例，但它无法根据需要开始工作。获取未定义的函数或子。

Sub Tester()

Dim p

'get the unpivoted data as a 2-D array
p = UnPivotData(Sheets("Sheet1").Range("A1").CurrentRegion, _
              3, False, False)
            
With Sheets("Sheet1").Range("H1")
    .CurrentRegion.ClearContents
    .Resize(UBound(p, 1), UBound(p, 2)).Value = p 'populate array to sheet
End With

'EDIT: alternative (slower) method to populate the sheet
'      from the pivoted dataset.  Might need to use this
'      if you have a large amount of data
'Dim r As Long, c As Long
'For r = 1 To Ubound(p, 1)
'For c = 1 To Ubound(p, 2)
'    Sheets("Sheet2").Cells(r, c).Value = p(r, c)
'Next c
'Next r

End Sub

我是 VBA 新手，并没有进行太多探索，我正在尝试为这项工作找到一个示例。

编辑

示例是否可以灵活地允许包含 500 多行的列数组，而不是仅匹配示例中的范围？

Answer 1

堆叠列

• 从Google Drive 下载工作簿（右上角的向下箭头）。
• 调整常量部分中的值。

Option Explicit

Sub stackColumns()
    
    Const sName As String = "Sheet1"
    Const sFirstColumn As String = "A"
    Const scCount As Long = 3
    
    Const dName As String = "Sheet1"
    Const dFirstCell As String = "H2"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim srg As Range
    Dim srCount As Long
    
    With wb.Worksheets(sName).Range("A1").CurrentRegion.Columns(sFirstColumn)
        srCount = .Rows.Count - 1
        Set srg = .Resize(srCount, scCount).Offset(1)
    End With
    
    Dim Data As Variant: Data = srg.Value
    
    Dim Result As Variant: ReDim Result(1 To srCount * scCount, 1 To 1)
    
    Dim r As Long, c As Long, n As Long
    
    For c = 1 To scCount
        For r = 1 To srCount
            n = n + 1
            Result(n, 1) = Data(r, c)
        Next r
    Next c
        
    With wb.Worksheets(dName).Range(dFirstCell)
        .Resize(n).Value = Result
        .Resize(.Worksheet.Rows.Count - .Row - n + 1).Offset(n).ClearContents
    End With
        
End Sub

编辑

Sub stackColumns2()
    
    Const sName As String = "Sheet1"
    Const sFirstColumn As String = "A"
    Const scCount As Long = 3
    
    Const dName As String = "Sheet1"
    Const dFirstCell As String = "H1"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim srg As Range: Set srg = wb.Worksheets(sName).Range("A1") _
        .CurrentRegion.Columns(sFirstColumn).Resize(, scCount)
    Dim srCount As Long: srCount = srg.Rows.Count
    
    Dim Data As Variant: Data = srg.Value
    
    Dim Result As Variant: ReDim Result(1 To srCount * scCount, 1 To 1)
    
    Dim r As Long, c As Long, n As Long
    
    For c = 1 To scCount
        For r = 1 To srCount
            n = n + 1
            Result(n, 1) = Data(r, c)
        Next r
    Next c
        
    With wb.Worksheets(dName).Range(dFirstCell)
        .Resize(n).Value = Result
        .Resize(.Worksheet.Rows.Count - .Row - n + 1).Offset(n).ClearContents
    End With
        
End Sub

Answer 2

要将多列转换为单列，并保持列顺序而不是转换为行顺序，只需在反透视之前转置表格即可。

例如：

let
    Source = Excel.CurrentWorkbook(){[Name="Table2"]}[Content],
    #"Transposed Table" = Table.Transpose(Source),
    #"Unpivoted Only Selected Columns" = Table.UnpivotOtherColumns(#"Transposed Table", {}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Only Selected Columns",{"Attribute"})
in
    #"Removed Columns"

在 2500 列 * 100 行的矩阵上，此查询在不到一秒的时间内完成。