将每 2 列转置到新行

Question

我已经得到了我需要的代码，但我需要一点帮助。这个代码只适用于 1 行，但是。我在多行上有数据，比如第 1 行在 A1、A101、A201 等行上......但它不适用于多行......任何人都可以提供帮助。谢谢！在屏幕截图 1 中，它是运行脚本之前的状态。它每 2 列取一次并将其放在新行中。但它不是运行多行...就像我有 1 个可转换数据A1 行，然后另一个在 A101 行、A201 行等等。

输入数据：

Sub dividde_16()

    No_of_columns = Cells(1, Columns.Count).End(xlToLeft).Column
    No_of_rows = Int(No_of_columns / 2) + 1

    For i = 1 To No_of_rows
        For j = 1 To 2
            Cells(i + 1, j) = Cells(i * 2 + j)
        Next
    Next
    Range(Cells(1, 3), Cells(1, No_of_columns)) = ""

End Sub

预期输出：

Answer 1

我对代码有一点乐趣，但它很有效。

Sub Columns2ToRows()
    Dim arData()
    Dim colCount As Long, x As Long

    colCount = Columns(Columns.Count).End(xlToLeft).Column
    ReDim arData(0)

    For x = 1 To colCount Step 2
        ReDim Preserve arData(Int(x / 2))
        arData(Int(x / 2)) = Array(Cells(1, x).Value, Cells(1, x + 1).Value)
    Next

    Rows(1).ClearContents

    arData = Application.Transpose(arData)
    arData = Application.Transpose(arData)

    Range("A1").Resize(UBound(arData), 2) = arData

End Sub

Answer 2

从公式上讲，您可以使用以下通用公式这样做：

=OFFSET($A,0,(ROW()-2)*cols+COLUMN()-1)

其中 "cols" 是列数。这假设源数据位于第 1 行，结果从第 2 行开始，如屏幕截图所示。

Answer 3

从如下示例数据开始。请注意，

标签成对出现。

运行这个子程序。

Sub wqewqwer()
    Dim rw As Long, iCOLs As Long, iROWs As Long
    Dim a As Long, aTMP1 As Variant, aTMP2 As Variant

    With Worksheets("Sheet12")
        With .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
            If CBool(Application.CountBlank(.Cells)) Then
                .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            End If
        End With

        For rw = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1
            aTMP1 = .Range(.Cells(rw, 2), .Cells(rw, .Columns.Count).End(xlToLeft)).Value2
            ReDim aTMP2(1 To Int(UBound(aTMP1, 2) / 2), 1 To 2)
            For a = LBound(aTMP1, 2) To UBound(aTMP1, 2) Step 2
                aTMP2(Int(a / 2) + 1, 1) = aTMP1(1, a)
                aTMP2(Int(a / 2) + 1, 2) = aTMP1(1, a + 1)
            Next a
            .Cells(rw + 1, 1).Resize(UBound(aTMP2, 1), 1).EntireRow.Insert
            .Cells(rw + 1, 1).Resize(UBound(aTMP2, 1), UBound(aTMP2, 2)) = aTMP2
            .Range(.Cells(rw, 2), .Cells(rw, .Columns.Count).End(xlToLeft)).Clear
        Next rw
    End With
End Sub

您的结果应该类似于以下内容。

将每 2 列转置到新行

Transpose every 2 columns to new row

excel

vba

transpose

输入数据：

预期输出：