从4x2表切割并粘贴到一行

Question

我有一个Excel电子表格，其中包含考试问题的答案。它被设置为一系列4x2块。每个块在第一列中有4个多项选择答案，然后右侧列中的0或1表示正确或不正确。

我想制作一个宏来取第2个，第3个和第4个答案以及相应的0/1单元并粘贴它们，使它们最终到达块中第一个答案的右侧。到目前为止，我有这个宏，它成功编辑了第一个答案和正确性指标列：

Range("A2:B2").Select
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
    Range("A3:B3").Select
Selection.Cut
Range("E1").Select
ActiveSheet.Paste
    Range("A4:B4").Select
Selection.Cut
Range("G1").Select
ActiveSheet.Paste

如何更改它以便它可以执行单元格2,3,4,6,7,8,10,11,12等，但跳过1,5,9等等？

谢谢！

Answer 1

给出输入：

使用代码：

Sub QReform()

Dim CurRow As Long, LastRow As Long

LastRow = Range("A" & Rows.Count).End(xlUp).Row

For CurRow = LastRow To 1 Step -1
    If ((CurRow - 1) / 5) - ((CurRow - 1) \ 5) = 0 Then
        Cells(CurRow, 2).Value = Cells(CurRow, 1).Offset(1, 0).Value
        Cells(CurRow, 3).Value = Cells(CurRow, 1).Offset(1, 1).Value
        Cells(CurRow, 4).Value = Cells(CurRow, 1).Offset(2, 0).Value
        Cells(CurRow, 5).Value = Cells(CurRow, 1).Offset(2, 1).Value
        Cells(CurRow, 6).Value = Cells(CurRow, 1).Offset(3, 0).Value
        Cells(CurRow, 7).Value = Cells(CurRow, 1).Offset(3, 1).Value
        Cells(CurRow, 8).Value = Cells(CurRow, 1).Offset(4, 0).Value
        Cells(CurRow, 9).Value = Cells(CurRow, 1).Offset(4, 1).Value
        Cells(CurRow, 1).Offset(4, 0).EntireRow.Delete xlShiftUp
        Cells(CurRow, 1).Offset(3, 0).EntireRow.Delete xlShiftUp
        Cells(CurRow, 1).Offset(2, 0).EntireRow.Delete xlShiftUp
        Cells(CurRow, 1).Offset(1, 0).EntireRow.Delete xlShiftUp
    End If
Next CurRow

End Sub

会给你这个：

Answer 2

我最终将列移动到文本编辑器中并使用正则表达式来完成工作，因为这是一种更简单的方法。我搜索了4行的块，并在适当的位置替换了带有标签的返回，以便它可以放在一行上并轻松返回到Excel。