宏将表格转置为列

Question

我在表中排列了数字，例如第一行1至10，然后在下一行11至20，然后21至30，依此类推 我希望每一行都应该转置为一列，就像在第1到10列中一样，然后在10、11到20以下，然后是21到30以下，依此类推

Answer 1

将以下代码添加到VBA编辑器中的新模块中...

Public Sub TransformDataToColumns()
    Dim rngCells As Range, objCell As Range, lngWriteRow As Long
    Dim objDestSheet As Worksheet

    Set rngCells = Selection
    Set objDestSheet = Sheets("Transformed")

    objDestSheet.Cells.Clear

    For Each objCell In rngCells
        lngWriteRow = lngWriteRow + 1
        objDestSheet.Cells(lngWriteRow, 1) = objCell.Value
    Next

    objDestSheet.Activate
End Sub

...在工作簿中添加一个名为 Transformed

的新工作表。

现在选择数据表（如下所示）并运行宏。一切保持不变，它应该为您工作。

Answer 2

尝试此代码

Sub Test()
Dim r1          As Range
Dim r2          As Range

With Sheets("Sheet1")
    Set r1 = .Range("A1:D" & .Columns("A:D").Find("*", [A1], , , 1, 2).Row)
    Set r2 = .Range("K1")
    MultipleColumnsIntoOne r1, r2
End With
End Sub

Sub MultipleColumnsIntoOne(rSource As Range, rDest As Range)
Dim a           As Variant
Dim b           As Variant
Dim i           As Long
Dim j           As Long
Dim k           As Long

a = rSource.Value
ReDim b(1 To UBound(a, 1) * rSource.Columns.Count)

For j = LBound(a, 2) To UBound(a, 2)
    For i = LBound(a, 1) To UBound(a, 1)
        If Not IsEmpty(a(i, j)) Then
            k = k + 1
            b(k) = a(i, j)
        End If
    Next i
Next j

rDest.Resize(k).Value = Application.Transpose(b)
End Sub