Vba 每2列换位到新行

我有我需要的代码，但我需要一点帮助。。这段代码仅适用于1行，但效果良好。我有多行的数据，比如第1行是A1行、A101行、A201行等等。。。但它不适用于多行。。有人能帮忙吗。谢谢 在屏幕截图1中，显示运行脚本之前的状态。。它每2列取一次，并将其放入新行。。但它不会运行多行。。。就像我在A1行有一个可转换的数据，然后在A101行，A201行，等等

输入数据：

预期产出：

---

我对代码有点兴趣，但它很有效

---

按照公式，您可以使用以下通用公式执行此操作：

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

---

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

从以下示例数据开始。请注意，标记成对出现

运行此子过程

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个图像的信息。我认为您应该做的第一件事是删除第2:100、102:200行中的空白，这不是你的叙述或代码所说的。非常感谢汤姆：）谢谢你接受我的回答！

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

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